' ********************************************************************************************************
'
' Modulo Creado y Editado Por Pol Florez Viciana
'                               01 / 01 / 2008 <---> 25 / 01 / 2014
'
'
' ********************************************************************************************************

Imports Microsoft.VisualBasic
Imports vb = Microsoft.VisualBasic
Imports Scripting
Imports System
Imports Microsoft.Win32
Imports System.Threading
Imports System.Security.Principal
Imports System.Runtime.InteropServices
Imports WbemScripting
Imports System.Diagnostics


Module EstructuraHTML

    Public Enum Alineacion
        ToLeft = 0
        ToRight = 1
        ToCenter = 2
    End Enum

    Public Function LiniaHorizontal(Optional ByVal Opciones As String = vbNullString) As String
        If Opciones = vbNullString Then
            LiniaHorizontal = "<hr>"
        Else
            LiniaHorizontal = "<hr " & Opciones & " >"
        End If
    End Function

    Public Function SaltoLinia() As String
        SaltoLinia = "<br>"
    End Function

    Public Function Encabezado(ByVal Texto As String) As String
        Encabezado = "<head>" & vbCrLf & Texto & vbCrLf & "</head>"
    End Function

    Public Function Cuerpo(ByVal Texto As String, Optional ByVal Opciones As String = vbNullString) As String
        If Opciones = vbNullString Then
            Cuerpo = "<body>" & vbCrLf & Texto & vbCrLf & "</body>"
        Else
            Cuerpo = "<body " & Opciones & " >" & vbCrLf & Texto & vbCrLf & "</body>"
        End If
    End Function

    Public Function Titulo(ByVal Texto As String, Optional ByVal Opciones As String = vbNullString) As String
        If Opciones = vbNullString Then
            Titulo = "<div>" & Texto & "</div>"
        Else
            Titulo = "<div " & Opciones & " >" & Texto & "</div>"
        End If
    End Function

    Public Function Parrafo(ByVal Texto As String, Optional ByVal Opciones As String = vbNullString) As String
        If Opciones = vbNullString Then
            Parrafo = "<div>" & Texto & "</div>"
        Else
            Parrafo = "<div " & Opciones & " >" & Texto & "</div>"
        End If
    End Function

    Public Function Texto(ByVal TextoContenido As String, Optional ByVal Opciones As String = vbNullString) As String
        If Opciones = vbNullString Then
            Texto = "<div>" & TextoContenido & "</div>"
        Else
            Texto = "<div " & Opciones & " >" & TextoContenido & "</div>"
        End If
    End Function

    Public Function Link(ByVal Texto As String, ByVal Direccion As String, ByVal Opciones1 As String, Opciones2 As String) As String
        Link = "<div " & Opciones1 & " ><a " & Opciones2 & Direccion & " >" & Texto & "</a></div>"
    End Function

    Public Function Audio(ByVal Opciones As String) As String
        Audio = "<audio " & Opciones & " ></audio>"
    End Function

    Public Function Video(ByVal Opciones As String) As String
        Video = "<video " & Opciones & " ></video>"
    End Function

    Public Function Imagen(ByVal Opciones As String) As String
        Imagen = "<img " & Opciones & " />"
    End Function

    Public Function IFrame(ByVal Opciones As String) As String
        IFrame = "<iframe " & Opciones & " ></iframe>"
    End Function

End Module


Module HTMLCode

    Public Enum HTMLTableCaptionPosition
        ToLeft = 0
        ToRight = 1
        ToTop = 2
        ToBottom = 3
    End Enum

    Public Enum HTMLTableAlignPositionHorizontal
        ToLeft = 0
        ToRight = 1
        ToCenter = 2
    End Enum

    Public Enum HTMLTableAlignPositionVertical
        ToTop = 0
        ToBottom = 1
        ToCenter = 2
    End Enum

    Public Enum HTMLBodyRepeatBackground
        NoneRepeat = 0
        RepeatVertical = 1
        RepeatHorizontal = 2
        Repeat = 3
    End Enum

    Public Enum HTMLLabelsHTypes
        H1 = 0
        H2 = 1
        H3 = 2
        H4 = 3
        H5 = 4
        H6 = 5
    End Enum

    Public Function CalcularDNI(ByVal Num As String) As String

        Dim Numero As Double
        Dim Tabla() As String
        Dim Resultado As Integer

        If Len(Num) < 7 Or Len(Num) > 8 Then
            CalcularDNI = "ERROR : el DNI deve de tener 7 o 8 numeros"
            Exit Function
        End If
        Numero = Num / 23
        Resultado = vb.Right(Numero, 2) - 1

        ReDim Tabla(22)
        Tabla(0) = "-T"
        Tabla(1) = "-R"
        Tabla(2) = "-W"
        Tabla(3) = "-A"
        Tabla(4) = "-G"
        Tabla(5) = "-M"
        Tabla(6) = "-Y"
        Tabla(7) = "-F"
        Tabla(8) = "-P"
        Tabla(9) = "-D"
        Tabla(10) = "-X"
        Tabla(11) = "-B"
        Tabla(12) = "-N"
        Tabla(13) = "-J"
        Tabla(14) = "-Z"
        Tabla(15) = "-S"
        Tabla(16) = "-Q"
        Tabla(17) = "-V"
        Tabla(18) = "-H"
        Tabla(19) = "-L"
        Tabla(20) = "-C"
        Tabla(21) = "-K"
        Tabla(22) = "-E"

        CalcularDNI = Tabla(Resultado)
    End Function

    Public Function HTMLCenterCodeStart() As String
        HTMLCenterCodeStart = "<CENTER>"
    End Function

    Public Function HTMLCenterCodeEnd() As String
        HTMLCenterCodeEnd = "</CENTER>"
    End Function

    Public Function HTMLPage(ByVal HeadCode As String, _
                             ByVal BodyCode As String, _
                    Optional ByVal TituloDocumento As String = vbNullString) As String
        HTMLPage = "<HTML>" & vbCrLf & HTMLTitleCode(TituloDocumento) & vbCrLf & _
                   HeadCode & vbCrLf & _
                   BodyCode & vbCrLf & "</HTML>"

    End Function

    Public Function HTMLHeadCode(ByVal HeadCode As String) As String

        HTMLHeadCode = "<head>" & vbCrLf & HeadCode & vbCrLf & "</head>"

    End Function

    Public Function HTMLBodyCode(ByVal BodyCode As String, _
                                 Optional ByVal BackGroundImage As String = vbNullString, _
                                 Optional ByVal RepeatMode As HTMLBodyRepeatBackground = HTMLBodyRepeatBackground.NoneRepeat) As String
        On Error Resume Next

        If BackGroundImage = vbNullString Then
            HTMLBodyCode = "<body>" & vbCrLf & BodyCode & vbCrLf & "</body>"

        Else
            Select Case RepeatMode
                Case HTMLBodyRepeatBackground.NoneRepeat
                    HTMLBodyCode = "<body background=" & Chr(34) & _
                                   BackGroundImage & Chr(34) & _
                                  " style=" & Chr(34) & "background-repeat:no-repeat" & Chr(34) & _
                                  ">" & vbCrLf & BodyCode & vbCrLf & _
                                  "</body>"

                Case HTMLBodyRepeatBackground.RepeatHorizontal
                    HTMLBodyCode = "<body background=" & Chr(34) & _
                                   BackGroundImage & Chr(34) & _
                                  " style=" & Chr(34) & "background-repeat:repeat-x" & Chr(34) & _
                                  ">" & vbCrLf & BodyCode & vbCrLf & _
                                  "</body>"
                Case HTMLBodyRepeatBackground.RepeatVertical
                    HTMLBodyCode = "<body background=" & Chr(34) & _
                                   BackGroundImage & Chr(34) & _
                                  " style=" & Chr(34) & "background-repeat:repeat-y" & Chr(34) & _
                                  ">" & vbCrLf & BodyCode & vbCrLf & _
                                  "</body>"
                Case HTMLBodyRepeatBackground.Repeat
                    HTMLBodyCode = "<body background=" & Chr(34) & _
                                   BackGroundImage & Chr(34) & _
                                  " style=" & Chr(34) & "background-repeat:repeat" & Chr(34) & _
                                  ">" & vbCrLf & BodyCode & vbCrLf & _
                                  "</body>"

            End Select

        End If

    End Function

    Public Function HTMLLinkCode(ByVal DireccionLink As String, _
                                 ByVal TextCodeLink As String, _
                       Optional ByVal StyleTextCode As String = "", _
                       Optional ByVal LinkInNewPage As Boolean = False) As String

        If StyleTextCode = vbNullString Then
            If LinkInNewPage = True Then
                HTMLLinkCode = "<a href=" & Chr(34) & DireccionLink & _
                                       Chr(34) & _
                                       " target=" & Chr(34) & "BLANK" & Chr(34) & ">" & _
                                       TextCodeLink & "</a>"
            Else
                HTMLLinkCode = "<a href=" & Chr(34) & DireccionLink & _
                           Chr(34) & Space(1) & _
                           ">" & TextCodeLink & "</a>"
            End If
        Else
            If LinkInNewPage = True Then
                HTMLLinkCode = "<a href=" & Chr(34) & DireccionLink & _
                                       Chr(34) & Space(1) & "style=" & Chr(34) & _
                                       StyleTextCode & Chr(34) & Space(1) & _
                                       " target=" & Chr(34) & "BLANK" & Chr(34) & ">" & _
                                       TextCodeLink & "</a>"
            Else
                HTMLLinkCode = "<a href=" & Chr(34) & DireccionLink & _
                           Chr(34) & Space(1) & "style=" & Chr(34) & _
                           StyleTextCode & Chr(34) & Space(1) & _
                           ">" & TextCodeLink & "</a>"
            End If
        End If

    End Function

    Public Function HTMLImageCode(ByVal DireccionImagen As String, _
                         Optional ByVal WidthImagenInPixels As Integer = 0, _
                         Optional ByVal HeightImagenInPixels As Integer = 0) As String
        HTMLImageCode = vbNullString

        If WidthImagenInPixels = 0 And HeightImagenInPixels = 0 Then
            HTMLImageCode = "<img src=" & Chr(34) & DireccionImagen & _
                            Chr(34) & " >"
        Else
            If WidthImagenInPixels > 0 Then
                If HeightImagenInPixels > 0 Then
                    HTMLImageCode = "<img src=" & Chr(34) & DireccionImagen & _
                            Chr(34) & " width=" & Chr(34) & WidthImagenInPixels & _
                            "px" & Chr(34) & " height=" & Chr(34) & HeightImagenInPixels & "px" & _
                            Chr(34) & " >"
                Else
                    HTMLImageCode = "<img src=" & Chr(34) & DireccionImagen & _
                            Chr(34) & " width=" & Chr(34) & WidthImagenInPixels & _
                            "px" & Chr(34) & " >"
                End If
            Else
                If HeightImagenInPixels > 0 Then
                    HTMLImageCode = "<img src=" & Chr(34) & DireccionImagen & _
                            Chr(34) & " height=" & Chr(34) & HeightImagenInPixels & "px" & _
                            Chr(34) & " >"
                End If
            End If
        End If

    End Function

    Public Function HTMLTitleCode(ByVal TituloDocumento As String) As String
        HTMLTitleCode = "<title>" & TituloDocumento & "</title>"
    End Function

    Public Function HTMLLabelH(ByVal TextoEtiquetaH As String, _
                       Optional ByVal TextoStyleCode As String = vbNullString, _
                       Optional ByVal TipoEtiquetaH As HTMLLabelsHTypes = HTMLLabelsHTypes.H1) As String
        HTMLLabelH = vbNullString
        Select Case TipoEtiquetaH
            Case HTMLLabelsHTypes.H1
                If TextoStyleCode = vbNullString Then
                    HTMLLabelH = "<H1>" & TextoEtiquetaH & "</h1>"
                Else
                    HTMLLabelH = "<H1 style=" & Chr(34) & TextoStyleCode & Chr(34) & " >" & _
                                 TextoEtiquetaH & "</h1>"
                End If
            Case HTMLLabelsHTypes.H2
                If TextoStyleCode = vbNullString Then
                    HTMLLabelH = "<H2>" & TextoEtiquetaH & "</h2>"
                Else
                    HTMLLabelH = "<H2 style=" & Chr(34) & TextoStyleCode & Chr(34) & " >" & _
                                 TextoEtiquetaH & "</h2>"
                End If
            Case HTMLLabelsHTypes.H3
                If TextoStyleCode = vbNullString Then
                    HTMLLabelH = "<H3>" & TextoEtiquetaH & "</h3>"
                Else
                    HTMLLabelH = "<H3 style=" & Chr(34) & TextoStyleCode & Chr(34) & " >" & _
                                 TextoEtiquetaH & "</h3>"
                End If
            Case HTMLLabelsHTypes.H4
                If TextoStyleCode = vbNullString Then
                    HTMLLabelH = "<H4>" & TextoEtiquetaH & "</h4>"
                Else
                    HTMLLabelH = "<H4 style=" & Chr(34) & TextoStyleCode & Chr(34) & " >" & _
                                 TextoEtiquetaH & "</h4>"
                End If
            Case HTMLLabelsHTypes.H5
                If TextoStyleCode = vbNullString Then
                    HTMLLabelH = "<H5>" & TextoEtiquetaH & "</h5>"
                Else
                    HTMLLabelH = "<H5 style=" & Chr(34) & TextoStyleCode & Chr(34) & " >" & _
                                 TextoEtiquetaH & "</h5>"
                End If
            Case HTMLLabelsHTypes.H6
                If TextoStyleCode = vbNullString Then
                    HTMLLabelH = "<H6>" & TextoEtiquetaH & "</h6>"
                Else
                    HTMLLabelH = "<H6 style=" & Chr(34) & TextoStyleCode & Chr(34) & " >" & _
                                 TextoEtiquetaH & "</h6>"
                End If
        End Select

    End Function

    Public Function HTMLLabelP(ByVal TextoEtiquetaH As String, _
                       Optional ByVal TextoStyleCode As String = vbNullString) As String
        HTMLLabelP = vbNullString
        If TextoStyleCode = vbNullString Then
            HTMLLabelP = "<P>" & TextoEtiquetaH & "</P>"
        Else
            HTMLLabelP = "<P style=" & Chr(34) & TextoStyleCode & Chr(34) & " >" & _
                         TextoEtiquetaH & "</P>"
        End If
    End Function

    Public Function HTMLSaltodeLinea() As String
        HTMLSaltodeLinea = "<br>"
    End Function

    Public Function HTMLTableCode(ByRef ObjetosBodyTabla As MFSFileDataSheetsColumn, _
                                  ByRef ObjetosHeadTabla As MFSFileDataSheetsColumn, _
                                  ByRef ObjetosFootTabla As MFSFileDataSheetsColumn, _
                         Optional ByVal AlineacionBodyH As HTMLTableAlignPositionHorizontal = HTMLTableAlignPositionHorizontal.ToCenter, _
                         Optional ByVal AlineacionBodyV As HTMLTableAlignPositionVertical = HTMLTableAlignPositionVertical.ToCenter, _
                         Optional ByVal AlineacionHeadH As HTMLTableAlignPositionHorizontal = HTMLTableAlignPositionHorizontal.ToCenter, _
                         Optional ByVal AlineacionHeadV As HTMLTableAlignPositionVertical = HTMLTableAlignPositionVertical.ToCenter, _
                         Optional ByVal AlineacionFootH As HTMLTableAlignPositionHorizontal = HTMLTableAlignPositionHorizontal.ToCenter, _
                         Optional ByVal AlineacionFootV As HTMLTableAlignPositionVertical = HTMLTableAlignPositionVertical.ToCenter, _
                         Optional ByVal TituloTabla As String = "", _
                         Optional ByVal PosicionTituloTabla As HTMLTableCaptionPosition = HTMLTableCaptionPosition.ToTop, _
                         Optional ByVal WidthTabla As Integer = 0, _
                         Optional ByVal HeightTabla As Integer = 0, _
                         Optional ByVal BorderTabla As Integer = 1) As String
        On Error Resume Next

        HTMLTableCode = vbNullString

        Dim Tempo As String, Man As Integer

        If WidthTabla = 0 And HeightTabla = 0 Then
            HTMLTableCode = "<table border=" & Chr(34) & BorderTabla & Chr(34) & " >" & vbCrLf
        Else
            If WidthTabla > 0 Then
                If HeightTabla > 0 Then
                    HTMLTableCode = "<table border=" & Chr(34) & BorderTabla & Chr(34) & " width=" & Chr(34) & WidthTabla & "px" & Chr(34) & " height=" & Chr(34) & HeightTabla & "px" & Chr(34) & " > " & vbCrLf
                Else
                    HTMLTableCode = "<table border=" & Chr(34) & BorderTabla & Chr(34) & " width=" & Chr(34) & WidthTabla & "px" & Chr(34) & " > " & vbCrLf
                End If
            Else
                If HeightTabla > 0 Then
                    HTMLTableCode = "<table border=" & Chr(34) & BorderTabla & Chr(34) & " height=" & Chr(34) & HeightTabla & "px" & Chr(34) & " > " & vbCrLf
                End If
            End If
        End If


        If TituloTabla <> vbNullString Then
            Select Case PosicionTituloTabla
                Case HTMLTableCaptionPosition.ToTop
                    HTMLTableCode = HTMLTableCode & "<caption align=" & Chr(34) & _
                                    "top" & Chr(34) & ">" & TituloTabla & "</caption>" & _
                                    vbCrLf
                Case HTMLTableCaptionPosition.ToLeft
                    HTMLTableCode = HTMLTableCode & "<caption align=" & Chr(34) & _
                                    "left" & Chr(34) & ">" & TituloTabla & "</caption>" & _
                                    vbCrLf
                Case HTMLTableCaptionPosition.ToBottom
                    HTMLTableCode = HTMLTableCode & "<caption align=" & Chr(34) & _
                                    "bottom" & Chr(34) & ">" & TituloTabla & "</caption>" & _
                                    vbCrLf
                Case HTMLTableCaptionPosition.ToRight
                    HTMLTableCode = HTMLTableCode & "<caption align=" & Chr(34) & _
                                    "right" & Chr(34) & ">" & TituloTabla & "</caption>" & _
                                    vbCrLf
            End Select
        End If

        If UBound(ObjetosFootTabla.Column) > 0 Then
            HTMLTableCode = HTMLTableCode & vbCrLf & _
                            "<TFOOT>" & vbCrLf
            Select Case AlineacionFootV
                Case HTMLTableAlignPositionVertical.ToCenter
                    Select Case AlineacionFootH
                        Case HTMLTableAlignPositionHorizontal.ToCenter
                            For Man = 0 To UBound(ObjetosFootTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosFootTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "middle" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToLeft
                            For Man = 0 To UBound(ObjetosFootTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosFootTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "left" & Chr(34) & " valign=" & Chr(34) & "middle" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToRight
                            For Man = 0 To UBound(ObjetosFootTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosFootTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "right" & Chr(34) & " valign=" & Chr(34) & "middle" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next

                    End Select
                Case HTMLTableAlignPositionVertical.ToTop
                    Select Case AlineacionFootH
                        Case HTMLTableAlignPositionHorizontal.ToCenter
                            For Man = 0 To UBound(ObjetosFootTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosFootTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "top" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToLeft
                            For Man = 0 To UBound(ObjetosFootTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosFootTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "top" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToRight
                            For Man = 0 To UBound(ObjetosFootTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosFootTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "right" & Chr(34) & " valign=" & Chr(34) & "top" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next

                    End Select

                Case HTMLTableAlignPositionVertical.ToBottom
                    Select Case AlineacionFootH
                        Case HTMLTableAlignPositionHorizontal.ToCenter
                            For Man = 0 To UBound(ObjetosFootTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosFootTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "bottom" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToLeft
                            For Man = 0 To UBound(ObjetosFootTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosFootTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "bottom" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToRight
                            For Man = 0 To UBound(ObjetosFootTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosFootTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "right" & Chr(34) & " valign=" & Chr(34) & "bottom" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next

                    End Select
            End Select
            HTMLTableCode = HTMLTableCode & vbCrLf & "</TFOOT>"
        End If

        If UBound(ObjetosHeadTabla.Column) > 0 Then
            HTMLTableCode = HTMLTableCode & vbCrLf & _
                            "<THEAD>" & vbCrLf
            Select Case AlineacionHeadV
                Case HTMLTableAlignPositionVertical.ToCenter
                    Select Case AlineacionHeadH
                        Case HTMLTableAlignPositionHorizontal.ToCenter
                            For Man = 0 To UBound(ObjetosHeadTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosHeadTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "middle" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToLeft
                            For Man = 0 To UBound(ObjetosHeadTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosHeadTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "left" & Chr(34) & " valign=" & Chr(34) & "middle" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToRight
                            For Man = 0 To UBound(ObjetosHeadTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosHeadTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "right" & Chr(34) & " valign=" & Chr(34) & "middle" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next

                    End Select
                Case HTMLTableAlignPositionVertical.ToTop
                    Select Case AlineacionHeadH
                        Case HTMLTableAlignPositionHorizontal.ToCenter
                            For Man = 0 To UBound(ObjetosHeadTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosHeadTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "top" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToLeft
                            For Man = 0 To UBound(ObjetosHeadTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosHeadTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "left" & Chr(34) & " valign=" & Chr(34) & "top" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToRight
                            For Man = 0 To UBound(ObjetosHeadTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosHeadTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "right" & Chr(34) & " valign=" & Chr(34) & "top" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                    End Select

                Case HTMLTableAlignPositionVertical.ToBottom
                    Select Case AlineacionHeadH
                        Case HTMLTableAlignPositionHorizontal.ToCenter
                            For Man = 0 To UBound(ObjetosHeadTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosHeadTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "bottom" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToLeft
                            For Man = 0 To UBound(ObjetosHeadTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosHeadTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "left" & Chr(34) & " valign=" & Chr(34) & "bottom" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToRight
                            For Man = 0 To UBound(ObjetosHeadTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosHeadTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<th align=" & Chr(34) & "right" & Chr(34) & " valign=" & Chr(34) & "bottom" & Chr(34) & " >" & Tempo & "</th>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                    End Select
            End Select

            HTMLTableCode = HTMLTableCode & vbCrLf & "</THEAD>"
        End If

        If UBound(ObjetosBodyTabla.Column) > 0 Then
            HTMLTableCode = HTMLTableCode & vbCrLf & _
                            "<TBODY>" & vbCrLf
            Select Case AlineacionBodyV
                Case HTMLTableAlignPositionVertical.ToCenter
                    Select Case AlineacionBodyH
                        Case HTMLTableAlignPositionHorizontal.ToCenter
                            For Man = 0 To UBound(ObjetosBodyTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosBodyTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<td align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "center" & Chr(34) & " >" & Tempo & "</td>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToLeft
                            For Man = 0 To UBound(ObjetosBodyTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosBodyTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<td align=" & Chr(34) & "left" & Chr(34) & " valign=" & Chr(34) & "center" & Chr(34) & " >" & Tempo & "</td>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToRight
                            For Man = 0 To UBound(ObjetosBodyTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosBodyTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<td align=" & Chr(34) & "right" & Chr(34) & " valign=" & Chr(34) & "center" & Chr(34) & " >" & Tempo & "</td>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next

                    End Select
                Case HTMLTableAlignPositionVertical.ToTop
                    Select Case AlineacionBodyH
                        Case HTMLTableAlignPositionHorizontal.ToCenter
                            For Man = 0 To UBound(ObjetosBodyTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosBodyTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<td align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "top" & Chr(34) & " >" & Tempo & "</td>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToLeft
                            For Man = 0 To UBound(ObjetosBodyTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosBodyTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<td align=" & Chr(34) & "left" & Chr(34) & " valign=" & Chr(34) & "top" & Chr(34) & " >" & Tempo & "</td>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToRight
                            For Man = 0 To UBound(ObjetosBodyTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosBodyTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<td align=" & Chr(34) & "right" & Chr(34) & " valign=" & Chr(34) & "top" & Chr(34) & " >" & Tempo & "</td>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next

                    End Select
                Case HTMLTableAlignPositionVertical.ToBottom
                    Select Case AlineacionBodyH
                        Case HTMLTableAlignPositionHorizontal.ToCenter
                            For Man = 0 To UBound(ObjetosBodyTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosBodyTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<td align=" & Chr(34) & "center" & Chr(34) & " valign=" & Chr(34) & "bottom" & Chr(34) & " >" & Tempo & "</td>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToLeft
                            For Man = 0 To UBound(ObjetosBodyTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosBodyTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<td align=" & Chr(34) & "left" & Chr(34) & " valign=" & Chr(34) & "bottom" & Chr(34) & " >" & Tempo & "</td>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next
                        Case HTMLTableAlignPositionHorizontal.ToRight
                            For Man = 0 To UBound(ObjetosBodyTabla.Column) - 1
                                HTMLTableCode = HTMLTableCode & vbCrLf & "<tr>"
                                For Each Tempo In ObjetosBodyTabla.Column(Man).Item
                                    HTMLTableCode = HTMLTableCode & vbCrLf & "<td align=" & Chr(34) & "right" & Chr(34) & " valign=" & Chr(34) & "bottom" & Chr(34) & " >" & Tempo & "</td>"
                                Next
                                HTMLTableCode = HTMLTableCode & vbCrLf & "</tr>"
                            Next

                    End Select
            End Select

            HTMLTableCode = HTMLTableCode & vbCrLf & "</TBODY>"
        End If

        HTMLTableCode = HTMLTableCode & vbCrLf & "</table>" & vbCrLf

    End Function

End Module

Module ProcesosSystem
    ' ***************************************************************
    ' Modulo Dedicado a controlar los procesos del sistema
    '
    ' Escrito por Pol Florez Viciana        05-05-2005 - 08-04-2013
    ' ***************************************************************

    ' Constantes de Utilizacion propia
    Private Const Cero = 0
    Private Const Uno = 1
    Private Const Dos = 2
    Private Const Tres = 3
    Private Const Cuatro = 4
    Private Const Cinco = 5
    Private Const Seis = 6
    Private Const Siete = 7
    Private Const Ocho = 8
    Private Const Nueve = 9
    Private Const Diez = 10
    Private Const Once = 11
    Private Const Doce = 12
    Private Const Trece = 13
    Private Const Catorce = 14
    Private Const Quince = 15
    Private Const Dieziseis = 16
    Private Const Diezisiete = 17
    Private Const Dieziocho = 18
    Private Const Diezinueve = 19
    Private Const Veinte = 20
    Private Const Veintiuno = 21
    Private Const Veintidos = 22
    Private Const Veintitres = 23
    Private Const Veinticuatro = 24
    Private Const Veinticinco = 25
    Private Const Veintiseis = 26
    Private Const Veintisiete = 27
    Private Const Veintiocho = 28
    Private Const Veintinueve = 29
    Private Const Treinta = 30
    Private Const Treintaiuno = 31
    Private Const Treintaidos = 32

    Private Const Nada As String = ""
    Private Const Barra As String = "/"
    Private Const Contrabarra As String = "\"
    Private Const Punto As String = "."
    Private Const DosPuntos As String = ":"
    Private Const Asterisco As String = "*"

    Private Const SeleccionWin32Process As String = "select * from win32_process"
    ' Declaracion tipos definidos por mi    ( Como no )
    Public Structure ProcessItem
        Public PID As Integer
        Public PHandle As Integer
        Public PName As String
        Public PPath As String
        Public PCommandLine As String
        Public PRealSize As Long
        Public PVirtualSize As Long
        Public PCreationDate As String ' Date Execution
        Public PCreationTime As String ' Time Execution
        Public PNameUser As String
        Public PNameDomain As String
    End Structure

    Public Structure ProcessList
        Public PItem() As ProcessItem
        Public PCount As Integer
    End Structure

    ' Declaracion de Funciones

    Public Function GetProcessTitleWindow(ByVal ProcessIdWindow As Integer) As String
        GetProcessTitleWindow = vbNullString
        On Error Resume Next

        Dim P As Process

        For Each P In Process.GetProcesses
            If P.Id = ProcessIdWindow Then
                GetProcessTitleWindow = P.MainWindowTitle
                Exit For
            End If
        Next

    End Function

    Public Function ToPositionWord(ByVal TextStrings As String, _
                                ByVal WordStrings As String, _
                                ByVal Direction As MFSStringsDirection, _
                       Optional ByVal IncludedWord As Boolean = True) As String
        Dim SystemLong As Long
        On Error Resume Next
        If Direction = MFSStringsDirection.ToLeft Then
            SystemLong = InStr(1, TextStrings, WordStrings, vbTextCompare)
            If IncludedWord = False Then
                SystemLong = SystemLong - Len(WordStrings)
                ToPositionWord = Left(TextStrings, SystemLong)
            Else
                ToPositionWord = Left(TextStrings, SystemLong)
            End If
        ElseIf Direction = MFSStringsDirection.ToRight Then
            TextStrings = StrReverse(TextStrings)
            WordStrings = StrReverse(WordStrings)
            SystemLong = InStr(1, TextStrings, WordStrings, 1)
            If IncludedWord = False Then
                SystemLong = SystemLong - Len(WordStrings)
                ToPositionWord = StrReverse(Left(TextStrings, SystemLong))
            Else
                ToPositionWord = StrReverse(Left(TextStrings, SystemLong))
            End If
        End If
    End Function

    Public Function TaskList() As String
        On Error Resume Next
        Dim strExe As String = "tasklist"

        'Armar el proceso a ejecutar
        Dim startInfo As System.Diagnostics.ProcessStartInfo = New System.Diagnostics.ProcessStartInfo(strExe)

        'Para poder manupular la salida indicamos que no se ejecute el shell
        startInfo.UseShellExecute = False

        'Por definicion (o mejor dicho codificacion) debemos ajustarnos a los que nos dice "San MSDN" 
        '(...)UseShellExecute debe ser true si se desea establecer ErrorDialog en true(...)
        startInfo.ErrorDialog = False

        'Sin ventana...
        startInfo.CreateNoWindow = True

        'Deseamos manipular la salida del proceso, para ello debemos establecer que se redirija la salida
        startInfo.RedirectStandardOutput = True
        Dim p As Diagnostics.Process = System.Diagnostics.Process.Start(startInfo)

        'Leemos la salida (objeto StreamReader)
        Dim sr As System.IO.StreamReader = p.StandardOutput
        Dim cadenaSalida As String = sr.ReadToEnd()
        sr.Close()

        'La visualizamos en el textbox. Un ejemplo basico ;)...
        TaskList = cadenaSalida

    End Function

    Public Function PingToHost(ByVal strArgumentos As String) As String
        On Error Resume Next
        Dim strExe As String = "ping"

        'Armar el proceso a ejecutar
        Dim startInfo As System.Diagnostics.ProcessStartInfo = New System.Diagnostics.ProcessStartInfo(strExe, "" & strArgumentos)

        'Para poder manupular la salida indicamos que no se ejecute el shell
        startInfo.UseShellExecute = False

        'Por definicion (o mejor dicho codificacion) debemos ajustarnos a los que nos dice "San MSDN" 
        '(...)UseShellExecute debe ser true si se desea establecer ErrorDialog en true(...)
        startInfo.ErrorDialog = False

        'Sin ventana...
        startInfo.CreateNoWindow = True

        'Deseamos manipular la salida del proceso, para ello debemos establecer que se redirija la salida
        startInfo.RedirectStandardOutput = True
        Dim p As Diagnostics.Process = System.Diagnostics.Process.Start(startInfo)

        'Leemos la salida (objeto StreamReader)
        Dim sr As System.IO.StreamReader = p.StandardOutput
        Dim cadenaSalida As String = sr.ReadToEnd()
        sr.Close()

        'La visualizamos en el textbox. Un ejemplo basico ;)...
        PingToHost = cadenaSalida

    End Function

    Public Function NetSTAT() As String
        On Error Resume Next
        Dim strExe As String = "netstat"

        'Armar el proceso a ejecutar
        Dim startInfo As System.Diagnostics.ProcessStartInfo = New System.Diagnostics.ProcessStartInfo(strExe, "-O")

        'Para poder manupular la salida indicamos que no se ejecute el shell
        startInfo.UseShellExecute = False

        'Por definicion (o mejor dicho codificacion) debemos ajustarnos a los que nos dice "San MSDN" 
        '(...)UseShellExecute debe ser true si se desea establecer ErrorDialog en true(...)
        startInfo.ErrorDialog = False

        'Sin ventana...
        startInfo.CreateNoWindow = True

        'Deseamos manipular la salida del proceso, para ello debemos establecer que se redirija la salida
        startInfo.RedirectStandardOutput = True
        Dim p As Diagnostics.Process = System.Diagnostics.Process.Start(startInfo)

        'Leemos la salida (objeto StreamReader)
        Dim sr As System.IO.StreamReader = p.StandardOutput
        Dim cadenaSalida As String = sr.ReadToEnd()
        sr.Close()

        'La visualizamos en el textbox. Un ejemplo basico ;)...
        NetSTAT = cadenaSalida
        MsgBox("Finalizado")
    End Function

    Public Function TraceDirection(ByVal strArgumentos As String) As String
        On Error Resume Next
        Dim strExe As String = "tracert"

        'Armar el proceso a ejecutar
        Dim startInfo As System.Diagnostics.ProcessStartInfo = New System.Diagnostics.ProcessStartInfo(strExe, " -h 3 -w 10 " & strArgumentos)

        'Para poder manupular la salida indicamos que no se ejecute el shell
        startInfo.UseShellExecute = False

        'Por definicion (o mejor dicho codificacion) debemos ajustarnos a los que nos dice "San MSDN" 
        '(...)UseShellExecute debe ser true si se desea establecer ErrorDialog en true(...)
        startInfo.ErrorDialog = False

        'Sin ventana...
        startInfo.CreateNoWindow = True

        'Deseamos manipular la salida del proceso, para ello debemos establecer que se redirija la salida
        startInfo.RedirectStandardOutput = True
        Dim p As Diagnostics.Process = System.Diagnostics.Process.Start(startInfo)

        'Leemos la salida (objeto StreamReader)
        Dim sr As System.IO.StreamReader = p.StandardOutput
        Dim cadenaSalida As String = sr.ReadToEnd()
        sr.Close()

        'Dim TempoMaquina As String
        'Dim O As String
        'La visualizamos en el textbox. Un ejemplo basico ;)...
        'O = Right(cadenaSalida, Len(cadenaSalida) - 1)
        'TempoMaquina = MFS.ToPositionWord(O, Chr(13), MFSStringsDirection.ToLeft, False)
        'TraceDirection = MFS.ToPositionWord(TempoMaquina, "a la ", MFSStringsDirection.ToRight, False)
        TraceDirection = cadenaSalida
        'TraceDirection = TempoMaquina
    End Function

    Private Function WinCV(Optional ByVal StringComputer As String = Punto) As String
        WinCV = "winmgmts:{impersonationLevel=impersonate}!\\" & StringComputer & "\root\cimv2"
        'WinCV = "winmgmts:{impersonationLevel=impersonate}!\\" & StringComputer & "\root\cimv2"
    End Function

    Public Function GetProcessUserCount(ByVal NombreUsuario As String, _
                               Optional ByVal StringComputer As String = Punto) As Integer
        On Error Resume Next

        ' Esta nos devolvera toda una Lista de Procesos activos

        Static Proceso As Object
        'Static objWMIService As Object
        Static colProcesses As WbemScripting.SWbemObjectSet
        Static Man As Integer, R As Integer
        Static TempoName As String, TempoDomain As String
        Static OWMI As SWbemServices
        ' Accedemos a los Objetos necesarios ( Servicio WMI )
        '         WMI = WINDOWS MANAGEMENT INSTRUMENTATION
        'objWMIService = GetObject(WinCV)
        ' Y dentro del Objeto WMI accedemos a la columna de procesos
        'colProcesses = objWMIService.ExecQuery(SeleccionWin32Process)

        OWMI = GetObject(WinCV(StringComputer))
        colProcesses = OWMI.ExecQuery(SeleccionWin32Process)

        ' Aņadimos los procesos que hay actualmente a ListCount
        'GetProcessList.PCount = colProcesses.Count
        ' Y redimensionamos el Array de Tipos de Proceso
        'ReDim GetProcessList.PItem(GetProcessList.PCount)

        ' La Var 'Man' nos servira para ir contando los procesos
        Man = Cero
        For Each Proceso In colProcesses
            TempoName = vbNullString
            TempoDomain = vbNullString
            R = Proceso.GetOwner(TempoName, TempoDomain)
            If LCase(TempoName) = LCase(NombreUsuario) Then
                Man = Man + Uno
            End If
        Next

        GetProcessUserCount = Man

    End Function

    Public Function GetProcessListByUser(ByVal NombreUsuario As String, _
                                Optional ByVal StringComputer As String = Punto) As ProcessList
        On Error Resume Next
        ' Esta nos devolvera toda una Lista de Procesos activos
        ReDim GetProcessListByUser.PItem(0)
        Static Proceso As Object
        'Static objWMIService As Object
        'Static colProcesses As Object
        Static colProcesses As WbemScripting.SWbemObjectSet
        Static Man As Integer, T As String, R As Integer
        Static TempoName As String
        Static TempoDomain As String
        Static OWMI As SWbemServices
        ' Accedemos a los Objetos necesarios ( Servicio WMI )
        '         WMI = WINDOWS MANAGEMENT INSTRUMENTATION
        'objWMIService = GetObject(WinCV)
        ' Y dentro del Objeto WMI accedemos a la columna de procesos
        'colProcesses = objWMIService.ExecQuery(SeleccionWin32Process)
        ' Aņadimos los procesos que hay actualmente a ListCount
        'GetProcessList.PCount = colProcesses.Count
        ' Y redimensionamos el Array de Tipos de Proceso
        OWMI = GetObject(WinCV(StringComputer))
        colProcesses = OWMI.ExecQuery(SeleccionWin32Process)

        ReDim GetProcessListByUser.PItem(GetProcessUserCount(NombreUsuario) - 1)

        ' La Var 'Man' nos servira para ir contando los procesos
        Man = Cero
        For Each Proceso In colProcesses
            TempoName = vbNullString
            TempoDomain = vbNullString
            R = Proceso.GetOwner(TempoName, TempoDomain)
            If LCase(TempoName) = LCase(NombreUsuario) Then
                'ReDim Preserve GetProcessListByUser.PItem(Man)
                T = Nada
                With GetProcessListByUser
                    .PItem(Man).PID = Proceso.ProcessId
                    .PItem(Man).PHandle = CInt(Proceso.ProcessId)
                    .PItem(Man).PName = Proceso.Name
                    .PItem(Man).PPath = Proceso.ExecutablePath
                    .PItem(Man).PRealSize = FileLen(.PItem(Man).PPath)
                    T = Proceso.CreationDate
                    .PItem(Man).PCreationDate = ObtainDateOrTime(True, T)
                    .PItem(Man).PCreationTime = ObtainDateOrTime(False, T)
                    .PItem(Man).PCommandLine = Proceso.CommandLine
                    .PItem(Man).PVirtualSize = Proceso.VirtualSize
                    .PItem(Man).PNameUser = TempoName
                    .PItem(Man).PNameDomain = TempoDomain
                End With
                Man = Man + Uno
            End If
        Next

        GetProcessListByUser.PCount = Man

    End Function

    Public Function GetColumnProcesses(Optional ByVal StringComputer As String = Punto) As WbemScripting.SWbemObjectSet
        On Error Resume Next
        Static OWMI As SWbemServices
        OWMI = GetObject(WinCV(StringComputer))
        GetColumnProcesses = OWMI.ExecQuery(SeleccionWin32Process)
    End Function

    Public Function GetProcessList(Optional ByVal StringComputer As String = Punto) As ProcessList
        On Error Resume Next
        ReDim GetProcessList.PItem(0)
        ' Esta nos devolvera toda una Lista de Procesos activos

        Static Proceso As SWbemObject
        'Static objWMIService As Object
        'Static colProcesses As Object
        Static colProcesses As WbemScripting.SWbemObjectSet
        Static Man As Integer, T As String, R As Integer
        Static TempoName As String
        Static TempoDomain As String
        Static OWMI As SWbemServices
        ' Accedemos a los Objetos necesarios ( Servicio WMI )
        '         WMI = WINDOWS MANAGEMENT INSTRUMENTATION
        'objWMIService = GetObject(WinCV)
        ' Y dentro del Objeto WMI accedemos a la columna de procesos
        'colProcesses = objWMIService.ExecQuery(SeleccionWin32Process)
        ' Aņadimos los procesos que hay actualmente a ListCount
        'GetProcessList.PCount = colProcesses.Count
        ' Y redimensionamos el Array de Tipos de Proceso
        OWMI = GetObject(WinCV(StringComputer))
        colProcesses = OWMI.ExecQuery(SeleccionWin32Process)

        ReDim GetProcessList.PItem(GetProcessCount(StringComputer) - 1)

        ' La Var 'Man' nos servira para ir contando los procesos
        Man = Cero
        For Each Proceso In colProcesses
            T = Nada
            With GetProcessList
                .PItem(Man).PID = Proceso.ProcessId
                .PItem(Man).PHandle = CInt(Proceso.ProcessId)
                .PItem(Man).PName = Proceso.Name
                .PItem(Man).PPath = Proceso.ExecutablePath
                .PItem(Man).PRealSize = FileLen(.PItem(Man).PPath)
                T = Proceso.CreationDate
                .PItem(Man).PCreationDate = ObtainDateOrTime(True, T)
                .PItem(Man).PCreationTime = ObtainDateOrTime(False, T)
                .PItem(Man).PCommandLine = Proceso.CommandLine
                .PItem(Man).PVirtualSize = Proceso.VirtualSize
                R = Proceso.GetOwner(.PItem(Man).PNameUser, .PItem(Man).PNameDomain)
            End With
            Man = Man + 1
        Next

        ' Aņadimos los procesos que hay actualmente a ListCount
        GetProcessList.PCount = Man
        ' Y redimensionamos el Array de Tipos de Proceso


    End Function

    Public Function GetProcessItem(ByVal PrcId As Integer, _
                          Optional ByVal StringComputer As String = Punto) As ProcessItem
        On Error Resume Next
        ' Esta nos servira para acceder a un solo proceso activo
        ' partiendo de su PID ( Process Identifier )

        Static Proceso As Object
        'Static objWMIService As Object
        'Static colProcesses As Object
        Static colProcesses As WbemScripting.SWbemObjectSet
        Static Man As Integer, T As String, R As Integer
        Static TempoName As String
        Static TempoDomain As String
        Static OWMI As SWbemServices
        ' Accedemos a los Objetos necesarios ( Servicio WMI )
        '         WMI = WINDOWS MANAGEMENT INSTRUMENTATION
        'objWMIService = GetObject(WinCV)
        ' Y dentro del Objeto WMI accedemos a la columna de procesos
        'colProcesses = objWMIService.ExecQuery(SeleccionWin32Process)
        ' Aņadimos los procesos que hay actualmente a ListCount
        'GetProcessList.PCount = colProcesses.Count
        ' Y redimensionamos el Array de Tipos de Proceso
        OWMI = GetObject(WinCV(StringComputer))
        colProcesses = OWMI.ExecQuery(SeleccionWin32Process)

        ' Y empezamos a leer uno a uno para ver cual tiene el PID
        ' solicitado
        For Each Proceso In colProcesses
            If PrcId = Proceso.ProcessId Then
                With GetProcessItem
                    T = Nada
                    .PID = Proceso.ProcessId
                    .PHandle = CLng(Proceso.ProcessId)
                    .PName = Proceso.Name
                    .PPath = Proceso.ExecutablePath
                    .PRealSize = FileLen(.PPath)
                    T = Proceso.CreationDate
                    .PCreationDate = ObtainDateOrTime(True, T)
                    .PCreationTime = ObtainDateOrTime(False, T)
                    .PCommandLine = Proceso.CommandLine
                    .PVirtualSize = Proceso.VirtualSize
                    R = Proceso.GetOwner(TempoName, TempoDomain)
                    .PNameUser = TempoName
                    .PNameDomain = TempoDomain
                End With
                Exit For
            End If
        Next

    End Function

    Public Function KillProcessItem(ByVal PrcId As Integer) As Boolean
        On Error Resume Next
        ' Esta nos servira para acceder a un solo proceso activo
        ' partiendo de su PID ( Process Identifier )

        Static Proceso As Process
        ' Y empezamos a leer uno a uno para ver cual tiene el PID
        ' solicitado
        For Each Proceso In Process.GetProcesses
            If PrcId = Proceso.Id Then
                Proceso.Kill()
                If Err.Number = 0 Then KillProcessItem = True
                Exit For
            End If
        Next

    End Function

    Public Function GetProcessCount(Optional ByVal StringComputer As String = Punto) As Integer
        On Error Resume Next

        ' Aqui solo declaramos el objeto WMI con las Columnas de Procesos

        GetProcessCount = Cero

        'Static objWMIService As Object
        'Static colProcesses As Object
        Static colProcesses As WbemScripting.SWbemObjectSet
        Static OWMI As SWbemServices
        ' Accedemos a los Objetos necesarios ( Servicio WMI )
        '         WMI = WINDOWS MANAGEMENT INSTRUMENTATION
        'objWMIService = GetObject(WinCV)
        ' Y dentro del Objeto WMI accedemos a la columna de procesos
        'colProcesses = objWMIService.ExecQuery(SeleccionWin32Process)
        ' Aņadimos los procesos que hay actualmente a ListCount
        'GetProcessList.PCount = colProcesses.Count
        ' Y redimensionamos el Array de Tipos de Proceso
        OWMI = GetObject(WinCV(StringComputer))
        colProcesses = OWMI.ExecQuery(SeleccionWin32Process)


        GetProcessCount = colProcesses.Count

    End Function

    Private Function ObtainDateOrTime _
            (ByVal DateTrueTimeFalse As Boolean, _
             ByVal OriginalDateCreation As String) As String
        On Error Resume Next
        ' Esta es de fabricacion propia y sirve para traducir
        ' la fecha y hora de ejecucion a formato legible
        Static YE As String, MO As String, DA As String
        Static HO As String, MI As String, Re As String, H As Long

        YE = Left(OriginalDateCreation, Cuatro) ' Aņo
        H = Len(OriginalDateCreation) - Cuatro
        Re = Right(OriginalDateCreation, H)
        MO = Left(Re, Dos)                      ' Mes
        H = Len(OriginalDateCreation) - Seis
        Re = Right(OriginalDateCreation, H)
        DA = Left(Re, Dos)                      ' Dia
        H = Len(OriginalDateCreation) - Ocho
        Re = Right(OriginalDateCreation, H)
        HO = Left(Re, Dos)                      ' Hora
        H = Len(OriginalDateCreation) - Diez
        Re = Right(OriginalDateCreation, H)
        MI = Left(Re, Dos)                      ' Minutos

        If DateTrueTimeFalse = True Then
            ObtainDateOrTime = DA & Barra & MO & Barra & YE
        Else
            ObtainDateOrTime = HO & DosPuntos & MI
        End If

    End Function

End Module

Module Pantallas

    ' Aqui declaro un tipo de datos en el que se incluyen cuatro posiciones
    Public Enum PantallasPosicionMenuInicio
        Superior = 0
        Inferior = 1
        Izquierda = 2
        Derecha = 3
        Ninguna = 4
    End Enum

    'Declaraciones del Modulo Pantallas
    Public Structure POINT_API
        Public X As Integer
        Public Y As Integer
    End Structure

    <DllImport("user32.dll")> _
    Private Function GetCursorPos(ByRef lpPoint As POINT_API) As Boolean
    End Function

    <DllImport("user32.dll")> _
    Private Function SetCursorPos(ByRef lpPoint As POINT_API) As Boolean
    End Function

    Public Structure PantallasMedidasObjeto
        Public Left As Integer
        Public Top As Integer
        Public Width As Integer
        Public Height As Integer
    End Structure

    Public Structure PantallasPosicionObjeto
        Public Left As Integer
        Public Top As Integer
    End Structure

    ' Aqui empiezan las funciones

    Public Function PosicionMenuInicio(ByRef Posicion As PantallasPosicionMenuInicio) As Boolean
        PosicionMenuInicio = False

        On Error Resume Next

        If Screen.PrimaryScreen.Bounds.Left <> Screen.PrimaryScreen.WorkingArea.Left Or Screen.PrimaryScreen.Bounds.Width <> Screen.PrimaryScreen.WorkingArea.Width Then
            If Screen.PrimaryScreen.Bounds.Left <> Screen.PrimaryScreen.WorkingArea.Left Then
                Posicion = PantallasPosicionMenuInicio.Izquierda
                PosicionMenuInicio = True
            Else
                Posicion = PantallasPosicionMenuInicio.Derecha
                PosicionMenuInicio = True
            End If
        End If

        If Screen.PrimaryScreen.Bounds.Top <> Screen.PrimaryScreen.WorkingArea.Top Or Screen.PrimaryScreen.Bounds.Height <> Screen.PrimaryScreen.WorkingArea.Height Then
            If Screen.PrimaryScreen.Bounds.Top <> Screen.PrimaryScreen.WorkingArea.Top Then
                Posicion = PantallasPosicionMenuInicio.Superior
                PosicionMenuInicio = True
            Else
                Posicion = PantallasPosicionMenuInicio.Inferior
                PosicionMenuInicio = True
            End If
        End If

        If PosicionMenuInicio = False Then
            Posicion = PantallasPosicionMenuInicio.Ninguna
            PosicionMenuInicio = True
        End If

    End Function

    Public Function PosicionLibre(ByRef PosicionDelCuadro As PantallasPosicionObjeto, _
                                  ByRef DimensionesDelCuadro As PantallasMedidasObjeto) As PantallasPosicionObjeto
        On Error Resume Next

        Dim P As PantallasMedidasObjeto
        Dim Man As Integer

        P = MedidasPantalla()
        If DimensionesDelCuadro.Width > P.Width Then Exit Function
        If DimensionesDelCuadro.Height > P.Height Then Exit Function

        If PosicionDelCuadro.Left + DimensionesDelCuadro.Width > P.Left And _
           PosicionDelCuadro.Left + DimensionesDelCuadro.Width < P.Width Then
            If PosicionDelCuadro.Top + DimensionesDelCuadro.Height > P.Top And _
               PosicionDelCuadro.Top + DimensionesDelCuadro.Height < P.Height Then
                PosicionLibre.Left = PosicionDelCuadro.Left
                PosicionLibre.Top = PosicionDelCuadro.Top
                Exit Function
            Else
                PosicionDelCuadro.Top = P.Height - (DimensionesDelCuadro.Height + 2)
                PosicionLibre.Left = PosicionDelCuadro.Left
                PosicionLibre.Top = PosicionDelCuadro.Top
                Exit Function
            End If
        Else
            PosicionDelCuadro.Left = P.Width - (DimensionesDelCuadro.Width + 2)
            PosicionLibre.Left = PosicionDelCuadro.Left
            PosicionLibre.Top = PosicionDelCuadro.Top
            Exit Function
        End If


    End Function

    Public Function GetPosicionCursor() As PantallasPosicionObjeto
        On Error Resume Next
        Dim P As POINT_API

        GetCursorPos(P)

        GetPosicionCursor.Left = P.X
        GetPosicionCursor.Top = P.Y

    End Function

    Public Sub SetPosicionCursor(ByRef Posicion As PantallasPosicionObjeto)
        On Error Resume Next
        Dim P As POINT_API

        P.X = Posicion.Left
        P.Y = Posicion.Top

        SetCursorPos(P)

    End Sub

    Public Function EncajaElObjeto(ByRef EsteObjeto As PantallasMedidasObjeto, _
                                   ByRef DentroDeEsteObjeto As PantallasMedidasObjeto) As Boolean
        On Error Resume Next
        EncajaElObjeto = False
        If EsteObjeto.Left > DentroDeEsteObjeto.Left And EsteObjeto.Width < DentroDeEsteObjeto.Width Then EncajaElObjeto = True : Exit Function
        If EsteObjeto.Top > DentroDeEsteObjeto.Top And EsteObjeto.Height < DentroDeEsteObjeto.Height Then EncajaElObjeto = True : Exit Function

    End Function

    Public Function NoEncajaEnPantalla(ByRef MedidasDelObjeto As PantallasMedidasObjeto) As Boolean
        On Error Resume Next
        NoEncajaEnPantalla = False

        Dim P As PantallasMedidasObjeto

        P = MedidasPantalla()

        If P.Left > MedidasDelObjeto.Left Then NoEncajaEnPantalla = True : Exit Function
        If P.Top > MedidasDelObjeto.Top Then NoEncajaEnPantalla = True : Exit Function
        If P.Width < MedidasDelObjeto.Width Then NoEncajaEnPantalla = True : Exit Function
        If P.Height < MedidasDelObjeto.Height Then NoEncajaEnPantalla = True : Exit Function

    End Function

    Public Function MedidasPantalla() As PantallasMedidasObjeto
        On Error Resume Next
        MedidasPantalla.Left = Screen.PrimaryScreen.WorkingArea.Left
        MedidasPantalla.Top = Screen.PrimaryScreen.WorkingArea.Top
        MedidasPantalla.Width = Screen.PrimaryScreen.WorkingArea.Width
        MedidasPantalla.Height = Screen.PrimaryScreen.WorkingArea.Height
    End Function

    Public Function PosicionCentroPantalla() As PantallasPosicionObjeto
        On Error Resume Next
        PosicionCentroPantalla.Left = (Screen.PrimaryScreen.WorkingArea.Width \ 2)
        PosicionCentroPantalla.Top = (Screen.PrimaryScreen.WorkingArea.Height \ 2)
    End Function

End Module


Module DatosWeb

    Public Function CrearTabla(ByRef Tabla As MFSFileDataSheetsColumn) As String
        On Error Resume Next



    End Function


    Public Function CrearFactura(ByVal Titulo As String, _
                            ByVal DireccionLogo As String, _
                            ByVal NombreEmpresa As String, _
                            ByVal DireccionEmpresa As String, _
                            ByVal NumeroVenta As String, _
                            ByVal NombreCliente As String, _
                            ByVal FechaFactura As String, _
                            ByVal PrecioTotal As String, _
                            ByRef Articulos() As String) As String
        CrearFactura = vbNullString

        Dim Articulo As String

        CrearFactura = "<HTML>" & vbCrLf & _
                  "<HEAD>" & vbCrLf & _
                  "<TITLE>" & vbCrLf & Titulo & "</TITLE>" & _
                  "</HEAD>" & vbCrLf & _
                  "<BODY>" & vbCrLf & _
                  "<IMG SRC=" & Chr(34) & DireccionLogo & Chr(34) & "><BR>" & vbCrLf & _
                  NombreEmpresa & "<BR>" & DireccionEmpresa & "<BR><BR>" & _
                  "Numero de Venta: " & NumeroVenta & "<BR><BR>" & vbCrLf & _
                  "Cliente: " & NombreCliente & "<BR><BR>" & vbCrLf & _
                  "Listado de Articulos:<BR>"

        For Each Articulo In Articulos
            CrearFactura = CrearFactura & Articulo & "<BR>"
        Next

        CrearFactura = CrearFactura & "<BR><BR>"

        CrearFactura = CrearFactura & "Importe: " & PrecioTotal & "<BR><BR>" & _
                  FechaFactura & "<BR>" & _
                  vbCrLf & "</BODY>" & _
                  vbCrLf & "</HTML>"

    End Function

End Module

Module Machine

    Public ObjetoShell As Shell32.Shell

    Public Sub OpenShutdown()
        On Error Resume Next

        Dim objShell

        objShell = CreateObject("shell.application")
        objShell.ShutdownWindows()

        objShell = Nothing

    End Sub

    Public Sub FindFiles()
        On Error Resume Next

        Dim objShell

        objShell = CreateObject("shell.application")
        objShell.FindFiles()

        objShell = Nothing

    End Sub

    Public Sub FileRun()
        On Error Resume Next

        Dim objShell

        objShell = CreateObject("shell.application")
        objShell.FileRun()

        objShell = Nothing

    End Sub

    Public Sub MinimizeAllWindows()
        On Error Resume Next

        Dim objShell

        objShell = CreateObject("shell.application")
        objShell.MinimizeAll()

        objShell = Nothing

    End Sub

    Public Sub UndoMinimizeAllWindows()
        On Error Resume Next

        Dim objShell

        objShell = CreateObject("shell.application")
        objShell.UndoMinimizeALL()

        objShell = Nothing

    End Sub

    Public Sub ShowPanelControl(ByVal HandleInteger32 As Integer)
        On Error Resume Next

        MFS.FileRunCommand(HandleInteger32, "control.exe")

    End Sub

    Public Sub ShowPanelUninstall(ByVal HandleInteger32 As Integer)
        On Error Resume Next

        MFS.FileRunCommand(HandleInteger32, "control.exe appwiz.cpl")
        'Dim X As Object 'Utilizamos una variable para la x del Shell
        'X = Shell("Rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl @0", AppWinStyle.NormalFocus) 'Aqui utilizamos Shell para llamar al panel de control
    End Sub

    Public Function IsFirstInstance(ByVal ApplicationName As String) As Boolean
        On Error Resume Next
        Dim P As Process
        Dim Man As Integer
        Man = 0

        For Each P In Process.GetProcesses
            If LCase(P.ProcessName) = LCase(ApplicationName) Then
                'MsgBox(P.ProcessName)
                Man = Man + 1
            End If
        Next

        If Man > 1 Then
            IsFirstInstance = False
        Else
            IsFirstInstance = True
        End If

    End Function

    Public Function EsAdministrador() As Boolean
        On Error Resume Next

        Thread.GetDomain().SetPrincipalPolicy(PrincipalPolicy.WindowsPrincipal)

        Dim myUser As WindowsPrincipal = TryCast(Thread.CurrentPrincipal, WindowsPrincipal)
        EsAdministrador = myUser.IsInRole(WindowsBuiltInRole.Administrator)

    End Function

    Public Function OSName() As String
        On Error Resume Next
        Dim SystemSet As Object, SystemD As Object
        SystemSet = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
        For Each SystemD In SystemSet
            OSName = SystemD.Caption
        Next
        SystemD = Nothing
        SystemSet = Nothing
    End Function

    Public Sub BloquedMachine(ByRef HandleInt As Integer)
        On Error Resume Next
        Dim T As String
        T = "rundll32.exe user32.dll,LockWorkStation"
        MFS.FileRunCommand(HandleInt, T)
    End Sub

    Public Sub CloseSesionMachine(ByRef HandleInt As Integer)
        On Error Resume Next
        Dim T As String
        T = "shutdown.exe /l "
        MFS.FileRunCommand(HandleInt, T)
    End Sub

    Public Sub SuspendMachine(ByRef HandleInt As Integer)
        On Error Resume Next
        Dim T As String
        T = "rundll32.exe PowrProf.dll, SetSuspendState"
        MFS.FileRunCommand(HandleInt, T)
    End Sub

    Public Sub RebootMachine()
        On Error Resume Next
        Dim OpSysSet As Object, OpSys As Object
        OpSysSet = GetObject("winmgmts:{(Shutdown)}//./root/cimv2").ExecQuery("select * from Win32_OperatingSystem where Primary=true")
        For Each OpSys In OpSysSet
            OpSys.Reboot(OpSys.Reboot)
        Next
    End Sub

    Public Sub ShutdownMachine()
        On Error Resume Next
        Dim OpSysSet As Object, OpSys As Object
        OpSysSet = GetObject("winmgmts:{(Shutdown)}//./root/cimv2").ExecQuery("select * from Win32_OperatingSystem where Primary=true")
        For Each OpSys In OpSysSet
            OpSys.Shutdown(OpSys.Shutdown)
        Next
    End Sub

End Module

Module Sounds

    'Función Api GetShortPathName para obtener _  
    'los paths de los archivos en formato corto  
    Private Declare Function GetShortPathName _
    Lib "kernel32" _
    Alias "GetShortPathNameA" ( _
        ByVal lpszLongPath As String, _
        ByVal lpszShortPath As String, _
       ByVal lBuffer As Long) As Long

    'Función Api mciExecute para reproducir los archivos de música  
    Private Declare Function mciExecute _
    Lib "winmm.dll" ( _
        ByVal lpstrCommand As String) As Long
    Dim ret As Long, path As String


    'Procedimiento que ejecuta el comando con el Api mciExecute  
    '************************************************************  
    Private Sub RunSound(ByVal comando As String, ByVal path As String)
        'If path = "" Then MsgBox("Error", vbCritical) : Exit Sub
        'Llamamos a mciExecute pasandole un string que tiene el comando y la ruta  
        mciExecute(comando & " " & Chr(34) & path & Chr(34))

    End Sub










    ' Constantes para los flags  

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  

    '  look for application specific association  
    Private Const SND_APPLICATION = &H80
    ' name is a WIN.INI [sounds] entry  
    Private Const SND_ALIAS = &H10000
    ' name is a WIN.INI [sounds] entry identifier  
    Private Const SND_ALIAS_ID = &H110000
    '  play asynchronously  
    Private Const SND_ASYNC = &H1
    '  play synchronously (default)  
    Private Const SND_SYNC = &H0

    '  name is a file name  
    Private Const SND_FILENAME = &H20000
    '  loop the sound until next sndPlaySound  
    Private Const SND_LOOP = &H8
    '  lpszSoundName points to a memory file  
    Private Const SND_MEMORY = &H4
    '  silence not default, if sound not found  
    Private Const SND_NODEFAULT = &H2
    '  don't stop any currently playing sound  
    Private Const SND_NOSTOP = &H10
    '  don't wait if the driver is busy  
    Private Const SND_NOWAIT = &H2000
    '  purge non-static events for task  
    Private Const SND_PURGE = &H40
    '  name is a resource name or atom  
    Private Const SND_RESOURCE = &H40004

    ' Declaración del api PlaySound  
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  
    Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" ( _
    ByVal lpszName As String, _
    ByVal hModule As Long, _
    ByVal dwFlags As Long) As Long

    ' Reproduce el archivo de sonido wav  
    Private Sub Reproducir_WAV(Archivo As String, Flags As Long)
        On Error Resume Next

        'Dim ret As Long
        ' Le pasa el path y los flags al api  
        Call PlaySound(Archivo, 0, Flags)
    End Sub


    Private Enum Flags
        SND_SYNC = &H0 ' play synchronously (default) 
        SND_ASYNC = &H1 ' play asynchronously 
        SND_NODEFAULT = &H2 ' silence (!default) if sound not found 
        SND_MEMORY = &H4 ' pszSound points to a memory file 
        SND_LOOP = &H8 ' loop the sound until next sndPlaySound 
        SND_NOSTOP = &H10 ' don't stop any currently playing sound 
        SND_NOWAIT = &H2000 ' don't wait if the driver is busy 
        SND_ALIAS = &H10000 ' name is a registry alias 
        SND_ALIAS_ID = &H110000 ' alias is a predefined ID 
        SND_FILENAME = &H20000 ' name is file name 
        SND_RESOURCE = &H40004 ' name is resource name or atom 
    End Enum


    Public Sub PlayThisSound(ByVal FilePath As String, Optional AudioLoop As Boolean = False)
        'On Error Resume Next
        'Dim Ret As Boolean
        'Dim Longi As Long

        'Static Man As Integer


        If AudioLoop = False Then
            'RunSound("play", FilePath)
            'Reproducir_WAV(FilePath, SND_FILENAME Or SND_ASYNC Or SND_NODEFAULT Or SND_NOSTOP)
            'Dim AudioAlias As String
            'AudioAlias = "Archivo"
            'Call mciSendString("open " & Chr(34) & FilePath & Chr(34) & " type WAV Alias " & AudioAlias & Man, 0, 0, 0)
            'Call mciSendString("Play " & AudioAlias & Man, 0, 0, 0)
            'Man = Man + 1
            'My.Computer.Audio.Stop()
            My.Computer.Audio.Play(FilePath)
            'My.Computer.Audio.Play(FilePath, AudioPlayMode.Background)
            'Call sndPlaySound(FilePath, SND_NODEFAULT + SND_NOWAIT)
            'Dim SoundInst As New SoundClass()
            'SoundInst.PlaySoundFile(FilePath)
            'Longi = SND_FILENAME ' + SND_ASYNC '+ SND_NODEFAULT
        Else
            'RunSound("play ", FilePath)

            'Call sndPlaySound(FilePath, SND_NODEFAULT + SND_NOWAIT + SND_LOOP)
            'My.Computer.Audio.Stop()
            'My.Application.Run(FilePath)
            My.Computer.Audio.Play(FilePath, AudioPlayMode.BackgroundLoop)
            'Longi = SND_LOOP
        End If
        'Ret = PlaySound(FilePath, vbNull, Longi)

        'If Ret = True Then PlayThisSound = True
    End Sub

    

    Private Function RegistryRead(ByVal KeyRegPath As String) As Object
        On Error Resume Next
        Static RegistryReg As Object
        RegistryReg = CreateObject("WScript.Shell")
        RegistryRead = RegistryReg.RegRead(KeyRegPath)
        RegistryReg = Nothing
    End Function
End Module

Module DateFunctions

    Public Function NumeroSemanasMes(ByVal Fecha As Date) As Integer
        On Error Resume Next

        Dim D, M, A As Integer
        Dim Man, Subman As Integer
        Dim NuevaFecha As Date

        M = CInt(Mes(Fecha))
        A = CInt(Ano(Fecha))

        Subman = 1
        Err.Clear()
        For Man = 1 To 31
            NuevaFecha = Man & "/" & M & "/" & A
            If Err.Number <> 0 Then Exit For
            D = DiaSemana(NuevaFecha)
            If D = 1 And Man <> 1 Then
                Subman = Subman + 1
            End If
            Err.Clear()
        Next

        NumeroSemanasMes = Subman

    End Function

    Public Function MismoDiaHora(ByVal Fecha1 As Date, ByVal Fecha2 As Date) As Boolean
        MismoDiaHora = False
        If Dia(Fecha1) = Dia(Fecha2) And _
           Mes(Fecha1) = Mes(Fecha2) And _
           Ano(Fecha1) = Ano(Fecha2) And _
           Hora(Fecha1) = Hora(Fecha2) Then
            MismoDiaHora = True
        End If
    End Function

    Public Function MismoAno(ByVal Fecha1 As Date, ByVal Fecha2 As Date) As Boolean
        MismoAno = False
        If Ano(Fecha1) = Ano(Fecha2) Then
            MismoAno = True
        End If
    End Function

    Public Function MismoMes(ByVal Fecha1 As Date, ByVal Fecha2 As Date) As Boolean
        MismoMes = False
        If Mes(Fecha1) = Mes(Fecha2) Then
            MismoMes = True
        End If
    End Function

    Public Function MismoDia(ByVal Fecha1 As Date, ByVal Fecha2 As Date) As Boolean
        MismoDia = False
        If Dia(Fecha1) = Dia(Fecha2) And _
           Mes(Fecha1) = Mes(Fecha2) And _
           Ano(Fecha1) = Ano(Fecha2) Then
            MismoDia = True
        End If
    End Function

    Public Function FechaSolo(ByVal Fecha As Date) As Date
        On Error Resume Next
        FechaSolo = Dia(Fecha) & "/" & Mes(Fecha) & "/" & Ano(Fecha)
    End Function

    Public Function ErrorDate(ByVal Fecha As Date) As Boolean
        On Error Resume Next
        Dim D As Date
        D = Fecha
        If Err.Number <> 0 Then ErrorDate = True Else ErrorDate = False
    End Function

    Public Function Ano(ByVal Fecha As Date) As String
        On Error Resume Next
        Ano = Year(Fecha)
    End Function

    Public Function Dia(ByVal Fecha As Date) As String
        On Error Resume Next
        Dia = Day(Fecha)
        If Len(Dia) = 1 Then Dia = "0" & Dia
    End Function

    Public Function DiaSemana(ByVal Fecha As Date) As Integer
        On Error Resume Next
        DiaSemana = vb.Weekday(Fecha, FirstDayOfWeek.Monday)
    End Function

    Public Function Mes(ByVal Fecha As Date) As String
        On Error Resume Next
        Mes = Month(Fecha)
        If Len(Mes) = 1 Then Mes = "0" & Mes
    End Function

    Public Function Hora(ByVal Fecha As Date) As String
        On Error Resume Next
        Hora = Hour(Fecha)
        If Len(Hora) = 1 Then Hora = "0" & Hora
    End Function

    Public Function Minuto(ByVal Fecha As Date) As String
        On Error Resume Next
        Minuto = Minute(Fecha)
        If Len(Minuto) = 1 Then Minuto = "0" & Minuto
    End Function

    Public Function Segundos(ByVal Fecha As Date) As String
        On Error Resume Next
        Segundos = Second(Fecha)
        If Len(Segundos) = 1 Then Segundos = "0" & Segundos
    End Function

    Public Function TextoHoraMinutos(ByVal Fecha As Date) As String
        On Error Resume Next
        Dim H, M As String

        H = Hora(Fecha)
        M = Minuto(Fecha)

        TextoHoraMinutos = H & ":" & M

    End Function

    Public Function TextoHoraMinutosSegundos(ByVal Fecha As Date) As String
        On Error Resume Next

        Dim H, M, S As String

        H = Hora(Fecha)
        M = Minuto(Fecha)
        S = Segundos(Fecha)

        TextoHoraMinutosSegundos = H & ":" & M & ":" & S
    End Function

    Public Function NumeroSemanasAno(ByVal Fecha As Date) As Integer
        On Error Resume Next
        NumeroSemanasAno = NumeroSemana("31/12/" & Ano(Fecha))

    End Function

    Public Function NumeroDiaAno(ByVal Fecha As Date) As Integer
        On Error Resume Next
        Dim Temp, SubTemp As Integer
        Dim TempFecha As Date


        For SubTemp = 1 To 12 Step 1
            For Temp = 1 To 31 Step 1
                TempFecha = Temp & "/" & SubTemp & "/" & Ano(Fecha)
                If Err.Number <> 0 Then Err.Clear() : Exit For
                If TempFecha > Fecha Then
                    Exit For
                    Exit For
                    Exit Function
                End If
                NumeroDiaAno = NumeroDiaAno + 1
            Next
        Next

        Return NumeroDiaAno
    End Function

    Public Function NumeroSemana(ByVal Fecha As Date) As Integer
        On Error Resume Next
        Dim Temp As Integer, SubTemp As Integer
        Dim TempFecha As Date, Count As Integer

        NumeroSemana = NumeroSemana + 1
        For SubTemp = 1 To 12 Step 1
            For Temp = 1 To 31 Step 1
                TempFecha = Temp & "/" & SubTemp & "/" & Ano(Fecha)
                If Err.Number <> 0 Then Err.Clear() : Exit For
                If TempFecha > Fecha Then
                    Exit For
                    Exit For
                    Exit Function
                End If
                If DiaSemana(TempFecha) = 1 Then
                    NumeroSemana = NumeroSemana + 1
                End If
            Next
        Next
    End Function

    Public Function NumeroDiasAno(ByVal Fecha As Date) As Integer
        On Error Resume Next
        Dim Temp, SubTemp, Retorno As Integer
        Dim FechaTemp As Date
        For SubTemp = 1 To 12
            FechaTemp = "01/" & SubTemp & "/" & Ano(Fecha)
            Retorno = NumeroDiasMes(FechaTemp)
            For Temp = 1 To Retorno
                NumeroDiasAno = NumeroDiasAno + 1
            Next
        Next


    End Function

    Public Function NumeroDiasMes(ByVal Fecha As Date) As Integer
        On Error Resume Next

        Dim M As Integer, A As Integer
        Dim Retorno As Integer

        M = CInt(Mes(Fecha))
        A = CInt(Ano(Fecha))

        Retorno = A Mod 4
        If Retorno = 0 Then
            Select Case M
                Case 1
                    Return 31
                Case 2
                    Return 29
                Case 3
                    Return 31
                Case 4
                    Return 30
                Case 5
                    Return 31
                Case 6
                    Return 30
                Case 7
                    Return 31
                Case 8
                    Return 31
                Case 9
                    Return 30
                Case 10
                    Return 31
                Case 11
                    Return 30
                Case 12
                    Return 31
            End Select
        Else
            Select Case M
                Case 1
                    Return 31
                Case 2
                    Return 28
                Case 3
                    Return 31
                Case 4
                    Return 30
                Case 5
                    Return 31
                Case 6
                    Return 30
                Case 7
                    Return 31
                Case 8
                    Return 31
                Case 9
                    Return 30
                Case 10
                    Return 31
                Case 11
                    Return 30
                Case 12
                    Return 31
            End Select
        End If

    End Function

    Public Function TextoFecha(ByVal Fecha As Date) As String
        On Error Resume Next
        Dim Temp1, Temp2, Temp3 As String

        Temp1 = DiaSemana(Fecha)
        Temp2 = Dia(Fecha)
        Temp3 = Mes(Fecha)

        TextoFecha = TextoDiaSemana(CByte(Temp1)) & " " & Temp2 & " de " & TextoMes(CByte(Temp3)) & " de " & Ano(Fecha)

    End Function

    Public Function TextoMes(ByVal Mes1Hasta12 As Byte) As String
        TextoMes = vbNullString
        Select Case Mes1Hasta12
            Case 1
                TextoMes = "Enero"
            Case 2
                TextoMes = "Febrero"
            Case 3
                TextoMes = "Marzo"
            Case 4
                TextoMes = "Abril"
            Case 5
                TextoMes = "Mayo"
            Case 6
                TextoMes = "Junio"
            Case 7
                TextoMes = "Julio"
            Case 8
                TextoMes = "Agosto"
            Case 9
                TextoMes = "Septiembre"
            Case 10
                TextoMes = "Octubre"
            Case 11
                TextoMes = "Noviembre"
            Case 12
                TextoMes = "Diciembre"
        End Select
    End Function


    Public Function TextoDiaSemana(ByVal Dia1Hasta7 As Byte) As String
        TextoDiaSemana = vbNullString
        Select Case Dia1Hasta7
            Case 1
                TextoDiaSemana = "Lunes"
            Case 2
                TextoDiaSemana = "Martes"
            Case 3
                TextoDiaSemana = "Miercoles"
            Case 4
                TextoDiaSemana = "Jueves"
            Case 5
                TextoDiaSemana = "Viernes"
            Case 6
                TextoDiaSemana = "Sabado"
            Case 7
                TextoDiaSemana = "Domingo"
        End Select
    End Function
End Module
Module Regedit

    Private Reg As Microsoft.Win32.Registry

    Public Enum RegeditStringsDirection
        ToLeft
        ToRight
    End Enum

    ' Enumeracion de Parametros de Registro
    ' ( Inicio de Clave )
    Public Enum RegistryParameter
        RegClassesRoot = &H80000000
        RegCurrentUser = &H80000001
        RegLocalMachine = &H80000002
        RegUsers = &H80000003
        RegCurrentConfig = &H80000005
        RegDynData = &H80000006
    End Enum

    Public Enum RegistryStartup
        StartupLocalMachine
        StartupCurrentUser
    End Enum

    ' Enumeracion de Tipos de Claves que se pueden Crear
    Public Enum RegistryKeyTypes
        RegSZ
        RegExpandSZ
        RegBinary
        RegDWord
        RegMultiSZ
    End Enum

    ' Tipo devuelto por la Funcion ReadSubKeys

    Public Structure RegistryKey
        Dim NameKey As String
        Dim PathKey As String
        Dim TypeKey As RegistryKeyTypes
    End Structure


    Public Structure RegistryKeysList
        Dim SubKey() As String           ' Varias SubKeys
        Dim Count As Integer             ' Cuenta de SubKeys
    End Structure


    Public Structure RegistrySubFolderKeysList
        Dim SubFolderKey() As Object
        'Dim SubFolderPath() As Object
        Dim Count As Integer
    End Structure

    Public Function ReadSubKeys(ByVal RegParameter As RegistryParameter, _
                                 ByVal RegKey As String) As RegistryKeysList
        ' Esta Funcion Devuelve un Array de Nombres
        ' de Subclaves de un Arbol del registro
        On Error Resume Next
        Dim ObjReg As Object
        Dim ArrStrings(0) As Object
        Dim ArrTypes(0) As Object
        Static Man As Integer
        ArrStrings(0) = vbNullString
        ArrTypes(0) = vbNullString
        ' Accedemos a un Objeto de Registro definido en la WMI
        ObjReg = GetObject("winmgmts:" & _
        "{impersonationLevel=impersonate}!\\" & _
            ".\root\default:StdRegProv")

        ' Y llamamos a la Funcion EnumKey del Objeto
        ObjReg.EnumValues(RegParameter, RegKey, _
                          ArrStrings, ArrTypes)


        'Dim instance As New System.NullReferenceException
        ReDim ReadSubKeys.SubKey(0)
        ' Si no hay SubClaves Salimos
        If Err.Number <> 0 Then ReadSubKeys.SubKey(0) = vbNullString : Exit Function

        ' De no ser asi establecemos los Valores a devolver
        ReadSubKeys.Count = UBound(ArrStrings) + 1
        ReDim ReadSubKeys.SubKey(UBound(ArrStrings))

        ' Ahora vamos estableciendo Valores Clave por Clave
        For Man = LBound(ArrStrings) To UBound(ArrStrings)
            ReadSubKeys.SubKey(Man) = ArrStrings(Man)
        Next

        ' Por Ultimo descargamos el Objeto Creado al Principio
        ObjReg = Nothing
    End Function

    Public Function ReadSubFolders(ByVal RegParameter As RegistryParameter, _
                                   ByVal RegKey As String) _
                                   As RegistrySubFolderKeysList
        ' Esta Funcion devuelve un Array de SubArboles de la
        ' Clave del Registro Indicada
        On Error Resume Next
        Dim ObjReg As Object
        Dim arrSubKeys(0) As Object
        Dim SubKey As Object
        Dim Cuenta As Integer

        ' Accedemos a un Objeto de Registro definido en la WMI
        ObjReg = GetObject("winmgmts:" & _
            "{impersonationLevel=impersonate}!\\" & _
            ".\root\default:StdRegProv")

        ' Y llamamos a la Funcion EnumKey del Objeto
        ObjReg.EnumKey(RegParameter, RegKey, arrSubKeys)

        ' Contamos todos los Valores Devueltos del Array
        For Each SubKey In arrSubKeys
            If SubKey = vbNullString Then Exit For
            Cuenta = Cuenta + 1
        Next

        ReDim ReadSubFolders.SubFolderKey(0)
        ' Si Cuenta = 0 Salimos porque no hay valores en esa
        ' Clave de Registro
        If Cuenta = 0 Then Exit Function
        ' De no ser asi establecemos el valor de Count y
        ' redimensionamos el Array para ir estableciendo Valores
        ReadSubFolders.Count = Cuenta
        ReDim ReadSubFolders.SubFolderKey(Cuenta - 1)

        ' A continuacion Leemos Valor por Valor y lo
        ' establecemos en el Array
        Cuenta = 0
        For Each SubKey In arrSubKeys
            ReadSubFolders.SubFolderKey(Cuenta) = SubKey
            Cuenta = Cuenta + 1
        Next

        ' Por Ultimo descargamos el Objeto Creado al Principio
        ObjReg = Nothing
    End Function

    Public Function ExistKey(ByVal KeyPath As String) As Boolean
        ' Comprobar si existe una Clave en el Registro
        On Error Resume Next
        Dim D As Object     ' Devuelve un Variant
        Dim ObjRegistro As Object

        ' Creamos un Objeto de Registro
        ObjRegistro = CreateObject("WScript.Shell")
        ' y accedemos a su valor
        D = ObjRegistro.RegRead(KeyPath)

        ' Si hay un error es que la Clave no existe
        If Err.Number = 0 Then ExistKey = True

        ' Descargamos el Objeto
        ObjRegistro = Nothing
    End Function

    Public Function ParameterNameKey(ByVal RegParameterA As RegistryParameter) As String
        ' Esta funcion nos servira para saber el Nombre del Parametro
        ' en la que se establecera o leera el/la arbol/Clave
        ParameterNameKey = "HKEY_LOCAL_MACHINE"

        If RegParameterA = RegistryParameter.RegClassesRoot Then
            ParameterNameKey = "HKEY_CLASSES_ROOT"
            Exit Function
        End If
        If RegParameterA = RegistryParameter.RegCurrentConfig Then
            ParameterNameKey = "HKEY_CURRENT_CONFIG"
            Exit Function
        End If
        If RegParameterA = RegistryParameter.RegCurrentUser Then
            ParameterNameKey = "HKEY_CURRENT_USER"
            Exit Function
        End If
        If RegParameterA = RegistryParameter.RegDynData Then
            ParameterNameKey = "HKEY_DYN_DATA"
            Exit Function
        End If
        If RegParameterA = RegistryParameter.RegLocalMachine Then
            ParameterNameKey = "HKEY_LOCAL_MACHINE"
            Exit Function
        End If
        If RegParameterA = RegistryParameter.RegUsers Then
            ParameterNameKey = "HKEY_USERS"
            Exit Function
        End If
    End Function

    Public Function WriteKey(ByVal KeyRegPath As String, _
                             ByVal ValueRegKey As Object, _
                             ByVal KeyType As RegistryKeyTypes) As Object  'Add New Key in Registry
        On Error Resume Next
        Dim RegistryReg As Object
        RegistryReg = CreateObject("WScript.Shell")
        With RegistryReg
            Select Case KeyType
                Case RegistryKeyTypes.RegDWord
                    .RegWrite(KeyRegPath, ValueRegKey, "REG_DWORD")
                Case RegistryKeyTypes.RegBinary
                    .RegWrite(KeyRegPath, ValueRegKey, "REG_BINARY")
                Case RegistryKeyTypes.RegSZ
                    .RegWrite(KeyRegPath, ValueRegKey, "REG_SZ")
                Case RegistryKeyTypes.RegMultiSZ
                    .RegWrite(KeyRegPath, ValueRegKey, "REG_MULTI_SZ")
                Case RegistryKeyTypes.RegExpandSZ
                    .RegWrite(KeyRegPath, ValueRegKey, "REG_EXPAND_SZ")
            End Select
        End With
        RegistryReg = Nothing
    End Function

    Public Function ReadKey(ByVal KeyRegPath As String) As Object
        On Error Resume Next
        Dim Reg As Object
        Reg = CreateObject("WScript.Shell")
        ReadKey = Reg.RegRead(KeyRegPath)
        Reg = Nothing
    End Function

    Public Function DeleteKey(ByVal KeyRegPath As String) As Boolean
        On Error Resume Next
        Dim Reg As Object
        Reg = CreateObject("WScript.Shell")
        Reg.RegDelete(KeyRegPath)
        If Err.Number = 0 Then DeleteKey = True
        Reg = Nothing
    End Function

    Public Function AddStartup(ByVal ApplicationPath As String, _
                               ByVal ApplicationName As String, _
                      Optional ByVal SetIn As RegistryStartup = RegistryStartup.StartupLocalMachine)
        On Error Resume Next

        Select Case SetIn
            Case RegistryStartup.StartupLocalMachine
                WriteKey("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & _
                         ApplicationName, ApplicationPath, RegistryKeyTypes.RegSZ)
            Case RegistryStartup.StartupCurrentUser
                WriteKey("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & _
                         ApplicationName, ApplicationPath, RegistryKeyTypes.RegSZ)
        End Select

    End Function

    Public Function DeleteStartup(ByVal ApplicationName As String, _
                         Optional ByVal SetIn As RegistryStartup = RegistryStartup.StartupLocalMachine)
        On Error Resume Next

        Select Case SetIn
            Case RegistryStartup.StartupLocalMachine
                DeleteKey("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & _
                         ApplicationName)
            Case RegistryStartup.StartupCurrentUser
                DeleteKey("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & _
                         ApplicationName)
        End Select

    End Function

    Public Sub OpenRegEdit()
        On Error Resume Next
        Shell("Regedit", vbNormalFocus)
    End Sub

    Public Function ToPositionWord(ByVal TextStrings As String, _
                                ByVal WordStrings As String, _
                                ByVal Direction As RegeditStringsDirection, _
                       Optional ByVal IncludedWord As Boolean = True) As String
        Static SystemLong As Long
        On Error Resume Next
        If Direction = RegeditStringsDirection.ToLeft Then
            SystemLong = InStr(1, TextStrings, WordStrings, vbTextCompare)
            If IncludedWord = False Then
                SystemLong = SystemLong - Len(WordStrings)
                ToPositionWord = Left(TextStrings, SystemLong)
            Else
                ToPositionWord = Left(TextStrings, SystemLong)
            End If
        ElseIf Direction = RegeditStringsDirection.ToRight Then
            TextStrings = StrReverse(TextStrings)
            WordStrings = StrReverse(WordStrings)
            SystemLong = InStr(1, TextStrings, WordStrings, Microsoft.VisualBasic.CompareMethod.Text)
            If IncludedWord = False Then
                SystemLong = SystemLong - Len(WordStrings)
                ToPositionWord = StrReverse(Left(TextStrings, SystemLong))
            Else
                ToPositionWord = StrReverse(Left(TextStrings, SystemLong))
            End If
        End If
    End Function

    Public Function StringParentFolder(ByVal FileOrFolderPath As String) As String
        If FileOrFolderPath = vbNullString Then StringParentFolder = vbNullString : Exit Function
        If Len(FileOrFolderPath) < 4 Then StringParentFolder = FileOrFolderPath
        Dim Tempo As String
        Tempo = ToPositionWord(FileOrFolderPath, "\", RegeditStringsDirection.ToRight, True)
        StringParentFolder = Left(FileOrFolderPath, Len(FileOrFolderPath) - Len(Tempo))
    End Function

    Public Function DeleteFolder(ByVal RegPath As String) As Boolean

        On Error Resume Next
        Dim Reg As Object
        Reg = CreateObject("WScript.Shell")
        Reg.RegDelete(RegPath)
        If Err.Number = 0 Then DeleteFolder = True
        Reg = Nothing
    End Function

End Module

Module SecurityModule


    Private Const Cero As Integer = 0
    Private Const Uno As Integer = 1
    Private Const Dos As Integer = 2
    Private Const CientoVeintiSiete As Integer = 127
    Private Const CientoVeintiOcho As Integer = 128

    Private C As String
    Private S As String
    Private Man As Long
    Private Code As Integer

    Private Enum StringsDirection
        ToLeft
        ToRight
    End Enum



    Public Function UserName() As String
        On Error Resume Next
        UserName = Environment.UserName
    End Function

    '    Public Function Encrypt(ByVal Word As String, ByVal Key As String, _
    '                    Optional ByVal Mode As Boolean = False) As String
    '
    '       On Error Resume Next
    '  Dim w As Long, k As Long, p As Long, j As Long, NuChr As Long
    ' Dim Cd As String, Kd As String, Rd As String
    '     Encrypt = vbNullString
    '    w = Len(Word)
    '    k = Len(Key)
    '' Modalidad de Encripción...
    '    If Mode = False Then
    '        For j = 1 To w
    '            Cd = Mid(Word, j, 1)
    '            If p = k Then p = 0
    '            p = p + 1
    '            Kd = Mid(Key, p, 1)
    '            NuChr = Asc(Cd) + Asc(Kd)
    '            If NuChr > 255 Then
    '                NuChr = NuChr - 255
    '            End If
    '            Rd = Rd & Chr(NuChr)
    '        Next
    '        Encrypt = Rd
    '        Exit Function
    '    End If
    '' Modalidad de Dencripción...
    '    If Mode = True Then
    '        For j = 1 To w
    '            Cd = Mid(Word, j, 1)
    '            If p = k Then p = 0
    '            p = p + 1
    '            Kd = Mid(Key, p, 1)
    '            NuChr = Asc(Cd) - Asc(Kd)
    '            If NuChr < 0 Then
    '                NuChr = NuChr + 255
    '            End If
    '            Rd = Rd & Chr(NuChr)
    '        Next
    '        Encrypt = Rd
    '        Exit Function
    '    End If
    'End Function

    Public Function LenSecureString() As Long
        On Error Resume Next
        Dim TempoData As String
        TempoData = WriteSecureString("Prueba")
        LenSecureString = Len(TempoData)
    End Function

    Public Function WriteSecureString(ByVal StringMax127 As String) As String
        If StringMax127 = vbNullString Then WriteSecureString = vbNullString : Exit Function
        On Error Resume Next
        Dim R As String, Man As Integer
        Dim Ch As String, T As String, Temp As String, Tempo As String
        R = vbNullString
        S = vbNullString
        Temp = vbNullString
        Tempo = vbNullString

        If Len(StringMax127) > CientoVeintiSiete Then S = Left(StringMax127, CientoVeintiSiete) Else S = StringMax127

        For Man = Len(S) To CientoVeintiOcho
            S = S & EndSecureString()
        Next

        For Man = Cero To CientoVeintiSiete
            If Man = Cero Then
                T = S
            Else
                T = Right(S, 129 - Man)
            End If
            Ch = Left(T, Uno)
            Tempo = R & StringToHex(Ch)
            R = Tempo
            Tempo = Temp & Ch
            Temp = Tempo
        Next

        'S = R
        S = CodifyString(R)

        WriteSecureString = "{" & S & "}"

    End Function

    Public Function ReadSecureString(ByVal SecureString As String) As String
        ReadSecureString = vbNullString
        If SecureString = vbNullString Then Exit Function
        If Left(SecureString, Uno) <> "{" Then Exit Function
        If Right(SecureString, Uno) <> "}" Then Exit Function
        If Len(SecureString) <> LenSecureString() Then Exit Function

        On Error Resume Next
        Dim R As String, Man As Integer
        Dim Temp As String, T As String, Y As Integer
        Dim Tempo As String

        Temp = vbNullString

        S = Right(SecureString, Len(SecureString) - Uno)
        S = Left(S, Len(S) - Uno)
        'R = S
        R = DeCodifyString(S)
        S = R

        For Man = Uno To CientoVeintiOcho
            T = Left(R, Dos)
            Tempo = Temp & HexToString(T)
            Temp = Tempo
            If Len(R) - Dos = Cero Then
                R = Right(S, Dos)
            Else
                R = Right(S, Len(R) - Dos)
            End If
        Next


        ReadSecureString = ToPositionWord(Temp, EndSecureString, StringsDirection.ToLeft, False)

    End Function

    Private Function ToPositionWord(ByVal TextStrings As String, _
                                   ByVal WordStrings As String, _
                                   ByVal Direction As StringsDirection, _
                          Optional ByVal IncludedWord As Boolean = True) As String

        ToPositionWord = vbNullString
        Dim SystemLong As Long
        On Error Resume Next
        If Direction = StringsDirection.ToLeft Then
            SystemLong = InStr(1, TextStrings, WordStrings, vbTextCompare)
            If IncludedWord = False Then
                SystemLong = SystemLong - Len(WordStrings)
                ToPositionWord = Left(TextStrings, SystemLong)
            Else
                ToPositionWord = Left(TextStrings, SystemLong)
            End If
        ElseIf Direction = StringsDirection.ToRight Then
            TextStrings = StrReverse(TextStrings)
            WordStrings = StrReverse(WordStrings)
            SystemLong = InStr(1, TextStrings, WordStrings, vbTextCompare)
            If IncludedWord = False Then
                SystemLong = SystemLong - Len(WordStrings)
                ToPositionWord = StrReverse(Left(TextStrings, SystemLong))
            Else
                ToPositionWord = StrReverse(Left(TextStrings, SystemLong))
            End If
        End If
    End Function

    Private Function EndSecureString() As String
        EndSecureString = Chr(26)
    End Function

    Public Function CodifyString(ByVal StringToCodify As String) As String
        'If StringToCodify = vbNullString Then CodifyString = vbNullString : Exit Function
        CodifyString = vbNullString
        'On Error Resume Next

        S = StringToCodify
        Code = Dos
        For SecurityModule.Man = Uno To Len(StringToCodify)
            C = Left(S, Uno)
            CodifyString = CodifyString & SumaStrings(C, Chr(Code))
            Code = Code + Dos
            If Code = CientoVeintiOcho Then Code = Dos : My.Application.DoEvents()
            S = Right(StringToCodify, Len(StringToCodify) - Man)

        Next

    End Function

    Public Function DeCodifyString(ByVal StringToCodify As String) As String
        ' If StringToCodify = vbNullString Then DeCodifyString = vbNullString : Exit Function
        DeCodifyString = vbNullString
        'On Error Resume Next
        S = StringToCodify
        Code = Dos
        For SecurityModule.Man = Uno To Len(StringToCodify)
            C = Left(S, Uno)
            DeCodifyString = DeCodifyString & RestaStrings(C, Chr(Code))
            Code = Code + Dos
            If Code = CientoVeintiOcho Then Code = Dos : My.Application.DoEvents()
            S = Right(StringToCodify, Len(StringToCodify) - Man)
        Next
    End Function


    Private Function SumaStrings(ByVal Char1 As String, ByVal Char2 As String) As String
        If Char1 = vbNullString Or Char2 = vbNullString Then SumaStrings = vbNullString : Exit Function
        On Error Resume Next
        Dim C1 As Integer, C2 As Integer, CR As Integer

        If Len(Char1) = 1 Then C1 = Asc(Char1) Else C1 = Asc(Left(Char1, 1))
        If Len(Char2) = 1 Then C2 = Asc(Char2) Else C2 = Asc(Left(Char2, 1))
        CR = C1 + C2
        If CR > 255 Then CR = CR - 256
        SumaStrings = Chr(CR)

    End Function

    Private Function RestaStrings(ByVal Char1 As String, ByVal Char2 As String) As String
        If Char1 = vbNullString Or Char2 = vbNullString Then RestaStrings = vbNullString : Exit Function
        On Error Resume Next
        Dim C1 As Integer, C2 As Integer, CR As Integer

        If Len(Char1) = 1 Then C1 = Asc(Char1) Else C1 = Asc(Left(Char1, 1))
        If Len(Char2) = 1 Then C2 = Asc(Char2) Else C2 = Asc(Left(Char2, 1))
        CR = C1 - C2
        If CR < 0 Then CR = CR + 256
        RestaStrings = Chr(CR)

    End Function

    Public Function StringToHex(ByRef CharToHex As String) As String
        If CharToHex = vbNullString Then
            Application.DoEvents()
            StringToHex = CharToHex
            Exit Function
        End If

        On Error Resume Next
        Dim C As String

        If Len(CharToHex) > 1 Then C = Left(CharToHex, 1) Else C = CharToHex
        StringToHex = Hex(Asc(C))
        If Len(StringToHex) = 1 Then StringToHex = "0" & StringToHex

    End Function

    Public Function HexToString(ByRef HexCode As String) As String
        If HexCode = vbNullString Then HexToString = HexCode : Exit Function
        On Error Resume Next
        Dim C As String, R As String, Man As Integer

        If Len(HexCode) = 1 Then C = "0" & HexCode Else C = Left(HexCode, 2)
        For Man = 0 To 255
            R = StringToHex(Chr(Man))
            If C = R Then HexToString = Chr(Man) : Exit For : Exit Function
        Next

    End Function


End Module

Module MFS
    ' Declaraciones de API's

    'Declare Function ShellExecute Lib "shell32.dll" (ByVal hwnd As Integer, ByVal lpOperation As String, _
    'ByVal lpFile As String, ByVal lpParameters As String, _
    'ByVal lpDirectory As String, ByVal nShowCmd As Integer) As Integer

    ' Constantes y Estructuras

    Public Enum ShellSpecialFolderConstants
        ssfDESKTOP = &H0
        ssfPROGRAMS = &H2
        ssfCONTROLS = &H3
        ssfPRINTERS = &H4
        ssfPERSONAL = &H5
        ssfFAVORITES = &H6
        ssfSTARTUP = &H7
        ssfRECENT = &H8
        ssfSENDTO = &H9
        ssfBITBUCKET = &HA
        ssfSTARTMENU = &HB
        ssfDESKTOPDIRECTORY = &H10
        ssfDRIVES = &H11
        ssfNETWORK = &H12
        ssfNETHOOD = &H13
        ssfFONTS = &H14
        ssfTEMPLATES = &H15
        ssfCOMMONSTARTMENU = &H16
        ssfCOMMONPROGRAMS = &H17
        ssfCOMMONSTARTUP = &H18
        ssfCOMMONDESKTOPDIR = &H19
        ssfAPPDATA = &H1A
        ssfPRINTHOOD = &H1B
        ssfLOCALAPPDATA = &H1C
        ssfALTSTARTUP = &H1D
        ssfCOMMONALTSTARTUP = &H1E
        ssfCOMMONFAVORITES = &H1F
        ssfINTERNETCACHE = &H20
        ssfCOOKIES = &H21
        ssfHISTORY = &H22
        ssfCOMMONAPPDATA = &H23
        ssfWINDOWS = &H24
        ssfSYSTEM = &H25
        ssfPROGRAMFILES = &H26
        ssfMYPICTURES = &H27
        ssfPROFILE = &H28
    End Enum


    Public FSO As New Scripting.FileSystemObject

    Public Enum MFSShellObject
        MFSSOCascadeWindows = 0
        MFSSOControlPanelItem = 1
        MFSSOEjectPC = 2
        MFSSOExplore = 3
        MFSSOFileRun = 4
        MFSSOFindComputer = 5
        MFSSOFindFiles = 6
        MFSSOHelp = 7
        MFSSOMinimizeAll = 8
        MFSSOSetTime = 9
        MFSSOShutdownWindows = 10
        MFSSOSuspend = 11
        MFSSOTileHorizontally = 12
        MFSSOTileVertically = 13
        MFSSOTrayProperties = 14
        MFSSOUndoMinimizeALL = 15
        MFSSOWindows = 16
    End Enum

    Public Enum MFSSpecialDirectory
        AllUserDesktop = 0
        AllUserStartMenu = 1
        AllUserStartMenuPrograms = 2
        AllUserStartupMenu = 3
        UserDesktop = 4
        UserDataOfProgram = 5
        UserPrinters = 6
        UserMasks = 7
        UserFonts = 8
        UserLAN = 9
        UserFavorites = 10
        UserStartMenu = 11
        UserRecent = 12
        UserStartupMenu = 14
        Desktop = 15
        UserMyDocs = 16
        UserStartMenuPrograms = 17
        WindowsDirectory = 18
        System32Directory = 19
        'TempDirectory
        UserTemp = 20
        RootDrivePath = 21
        ProgramFiles = 22
        UserMyPictures = 23
        UserMyVideos = 24
        UserMyMusic = 25
        UserSendTo = 26
        'Cookies
    End Enum

    Public Structure SHFILEOPSTRUCT
        Public hWnd As Integer
        Public wFunc As Integer
        Public pFrom As String
        Public pTo As String
        Public fFlags As Integer ' As Long para que funcione en Windows XP con VB6
        Public fAborted As Boolean
        Public hNameMaps As Integer
        Public sProgress As String
    End Structure


    Public Const FO_DELETE = &H3
    Public Const FOF_ALLOWUNDO = &H40

    Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (ByRef lpFileOp As SHFILEOPSTRUCT) As Integer


    ' Tipos y constantes para el tipo de archivo de registros
    Private Const Title As String = "MFSFileDataSheetsArray"
    Private Const Title2 As String = "MFSFileDataSheets2.0"
    Private Const Title3 As String = "MFSFileDataSheets3.0"
    Private Const TitleEncript As String = "MFSFileDataEncripted"
    Private Const Cero = 0
    Private Const Uno = 1
    Private Const ContraBarra As String = "\"

    Public Enum MFSFileSystemObjectType
        NothingType = 0
        DriveType = 1
        FolderType = 2
        FileType = 3
    End Enum

    Public Structure MFSFileDataSheetsItem
        Public Item() As String
    End Structure

    Public Structure MFSFileDataSheetsColumn
        Public Column() As MFSFileDataSheetsItem
    End Structure

    ' Tipos y constantes para special folder

    Public Enum MFSSpecialFolder
        SystemFolder = 0
        TempFolder = 1
        WindowsFolder = 2
    End Enum


    Public Enum MFSStringsDirection
        ToLeft
        ToRight
    End Enum


    Public Structure MFSFileINIDataList
        Public LineItem() As String
        Public LinesCount As Integer
    End Structure

    Public Structure MFSDataSizeBytes
        Public TotalBytes As String
        Public TotalKiloBytes As String
        Public TotalMegaBytes As String
        Public TotalGigaBytes As String
    End Structure
    ' Funciones Genericas para el Modulo

    'Public Function EsAdministrador() As Boolean
    '    On Error Resume Next
    '    Thread.GetDomain().SetPrincipalPolicy(PrincipalPolicy.WindowsPrincipal)
    '
    '    Dim myUser As WindowsPrincipal '= TryCast(Thread.CurrentPrincipal, WindowsPrincipal)
    '    Return myUser.IsInRole(WindowsBuiltInRole.Administrator)
    '
    ' End Function


    Public Function BytesToShortUnit(ByVal NumBytes As String) As MFSDataSizeBytes
        On Error Resume Next

        Dim NewBytes As String
        Dim Y As Double


        With BytesToShortUnit

            .TotalGigaBytes = 0
            .TotalMegaBytes = 0
            .TotalKiloBytes = 0
            .TotalBytes = 0

            'If NumBytes >= 1073741824 Then
            Y = (NumBytes / 1024 / 1024 / 1024)
            Y = FormatCurrency(Y, 2)
            .TotalGigaBytes = Y
            'End If

            'If NumBytes >= 1048576 Then
            Y = (NumBytes / 1024 / 1024)
            Y = FormatCurrency(Y, 2)
            .TotalMegaBytes = Y
            'End If

            'If NumBytes >= 1024 Then
            Y = NumBytes / 1024
            Y = FormatCurrency(Y, 2)
            .TotalKiloBytes = Y
            'End If

            .TotalBytes = NumBytes
        End With

    End Function

    Public Function BytesToShortUnitString(ByVal NumBytes As String) As String
        On Error Resume Next

        Dim NewBytes As String
        Dim Y As Double

        If NumBytes >= 1024 Then
            If NumBytes >= 1048576 Then
                If NumBytes >= 1073741824 Then
                    Y = (NumBytes / 1024 / 1024 / 1024)
                    Y = FormatCurrency(Y, 2)
                    NewBytes = Y & " GigaBytes"
                Else
                    Y = (NumBytes / 1024 / 1024)
                    Y = FormatCurrency(Y, 2)
                    NewBytes = Y & " MegaBytes"
                End If
            Else
                Y = NumBytes / 1024
                Y = FormatCurrency(Y, 2)
                NewBytes = Y & " KiloBytes"
            End If
        Else
            NewBytes = NumBytes & " bytes"
        End If

        BytesToShortUnitString = NewBytes
    End Function

    Public Function DriveIsFixedDrive(ByVal DrivePath As String) As Boolean
        On Error Resume Next
        DriveIsFixedDrive = False
        Dim U As Drive
        Dim FSO As New FileSystemObject

        U = FSO.GetDrive(DrivePath)
        If Err.Number <> 0 Then Exit Function
        If U.DriveType = DriveTypeConst.Fixed Then
            DriveIsFixedDrive = True
        End If

    End Function

    Public Function DriveIsRAMDrive(ByVal DrivePath As String) As Boolean
        On Error Resume Next
        DriveIsRAMDrive = False
        Dim U As Drive
        Dim FSO As New FileSystemObject

        U = FSO.GetDrive(DrivePath)
        If Err.Number <> 0 Then Exit Function
        If U.DriveType = DriveTypeConst.RamDisk Then
            DriveIsRAMDrive = True
        End If

    End Function

    Public Function DriveIsCDROMDrive(ByVal DrivePath As String) As Boolean
        On Error Resume Next
        DriveIsCDROMDrive = False
        Dim U As Drive
        Dim FSO As New FileSystemObject

        U = FSO.GetDrive(DrivePath)
        If Err.Number <> 0 Then Exit Function
        If U.DriveType = DriveTypeConst.CDRom Then
            DriveIsCDROMDrive = True
        End If

    End Function

    Public Sub EjecutarObjetoShell(ByVal TipoObjeto As MFSShellObject, Optional ByVal NombrePanelCPL As String = vbNullString)

        Dim oShell As New Shell32.Shell

        Select Case TipoObjeto
            Case MFSShellObject.MFSSOCascadeWindows ' "CascadeWindows"
                oShell.CascadeWindows()
            Case MFSShellObject.MFSSOControlPanelItem ' "ControlPanelItem"
                oShell.ControlPanelItem(NombrePanelCPL) '"INETCPL.cpl"
            Case MFSShellObject.MFSSOEjectPC ' "EjectPC"
                oShell.EjectPC()
            Case MFSShellObject.MFSSOExplore ' "Explore"
                oShell.Explore(ShellSpecialFolderConstants.ssfDRIVES)
                'oShell.Explore "C:\"
            Case MFSShellObject.MFSSOFileRun ' "FileRun"
                oShell.FileRun()
            Case MFSShellObject.MFSSOFindComputer ' "FindComputer"
                oShell.FindComputer()
            Case MFSShellObject.MFSSOFindFiles ' "FindFiles"
                oShell.FindFiles()
            Case MFSShellObject.MFSSOHelp ' "Help"
                oShell.Help()
            Case MFSShellObject.MFSSOMinimizeAll ' "MinimizeAll"
                oShell.MinimizeAll()
            Case MFSShellObject.MFSSOSetTime ' "SetTime"
                oShell.SetTime()
            Case MFSShellObject.MFSSOShutdownWindows ' "ShutdownWindows"
                oShell.ShutdownWindows()
            Case MFSShellObject.MFSSOSuspend ' "Suspend"
                oShell.Suspend()
            Case MFSShellObject.MFSSOTileHorizontally ' "TileHorizontally"
                oShell.TileHorizontally()
            Case MFSShellObject.MFSSOTileVertically ' "TileVertically"
                oShell.TileVertically()
            Case MFSShellObject.MFSSOTrayProperties ' "TrayProperties"
                oShell.TrayProperties()
            Case MFSShellObject.MFSSOUndoMinimizeALL ' "UndoMinimizeALL"
                oShell.UndoMinimizeALL()
            Case MFSShellObject.MFSSOWindows ' "Windows"
                oShell.Windows()
        End Select

    End Sub

    Public Function TextToHexText(ByVal TextStrings As String) As String
        If TextStrings = vbNullString Then TextToHexText = vbNullString : Exit Function
        Dim C, Tempo As String
        Tempo = vbNullString
        Do Until TextStrings = vbNullString
            C = Left(TextStrings, 1)
            Tempo = Tempo & HexByChar(C)
            TextStrings = Right(TextStrings, Len(TextStrings) - 1)
        Loop
        TextToHexText = Tempo
    End Function

    Public Function HexTextToText(ByVal HexStrings As String) As String
        HexTextToText = vbNullString
        If HexStrings = vbNullString Then Exit Function
        On Error Resume Next
        Dim C As String, Tempo As String, SubTempo As String
        Tempo = vbNullString
        SubTempo = vbNullString
        Do Until HexStrings = vbNullString
            C = Left(HexStrings, 2)
            SubTempo = Tempo & CharByHex(C)
            Tempo = SubTempo
            HexStrings = Right(HexStrings, Len(HexStrings) - 2)
        Loop
        HexTextToText = Tempo
    End Function

    Public Function CharByHex(ByVal HexStrings As String) As String
        If HexStrings = vbNullString Then CharByHex = vbNullString : Exit Function
        On Error Resume Next
        If Len(HexStrings) <> 2 Then CharByHex = "00" : Exit Function ' NullString

        Static Man As Integer
        For Man = 0 To 255
            If HexByChar(Chr(Man)) = HexStrings Then
                CharByHex = Chr(Man)
                Exit For
                Exit Function
            End If
        Next

        HexStrings = "00" ' NullString

    End Function

    Public Function HexByChar(ByVal CharString As String) As String  ' Return Two Chars. ( Hex. Char )
        If CharString = vbNullString Then HexByChar = vbNullString : Exit Function
        On Error Resume Next
        If Len(CharString) > 1 Then CharString = Left(CharString, 1)
        HexByChar = Hex(Asc(CharString))
        If HexByChar = vbNullString Then HexByChar = 0
        If Len(HexByChar) < 2 Then HexByChar = "0" & HexByChar
    End Function

    Public Function StringDeleteSpaces(ByVal TextString As String) As String
        On Error Resume Next
        StringDeleteSpaces = Replace(TextString, " ", vbNullString)
    End Function

    Public Function WordsCount(ByVal TextString As String, _
                  Optional ByVal WordString As String = vbNullString, _
                  Optional ByVal EqualWord As Boolean = True) As Long
        On Error Resume Next
        WordsCount = 0
        If TextString = WordString Then WordsCount = 1 : Exit Function
        If TextString = vbNullString Then Exit Function
        If WordString = vbNullString Then
            ' Si no existe Palabra a Buscar es que se quiere Obtener el Numero de Palabras
            ' que contiene el Texto asi que salimos...
            Exit Function
        Else
            ' En Caso Contrario, Contamos las Palabras que sean Iguales que WordString
            ' Comprobamos si la Palabra Tiene que ser Exacta...
            If EqualWord = True Then
                ' Si tiene que ser Exacta
                If Len(TextString) = _
                   Len(Replace(TextString, WordString, vbNullString)) Then Exit Function
                WordsCount = _
                   Len(TextString) - ((Len(Replace(TextString, WordString, vbNullString, 1, -1, Microsoft.VisualBasic.CompareMethod.Binary)) \ Len(WordString)))
            Else
                ' Si No tiene que ser Exacta
                TextString = LCase(TextString)
                WordString = LCase(WordString)
                If Len(TextString) = _
                   Len(Replace(TextString, WordString, vbNullString, 1, -1, Microsoft.VisualBasic.CompareMethod.Binary)) Then Exit Function
                WordsCount = _
                   Len(TextString) - ((Len(Replace(TextString, WordString, vbNullString)) \ Len(WordString)))
            End If
        End If
    End Function

    Public Function WordExist(ByVal TextString As String, _
                              ByVal WordString As String) As Boolean
        WordExist = False
        If WordsCount(TextString, WordString, True) > 0 Then WordExist = True
    End Function

    Public Function WordReverse(ByVal WordString As String) As String
        WordReverse = StrReverse(WordString)
    End Function

    Public Function WordsDelete(ByVal TextString As String, _
                                ByVal WordToDelete As String) As String
        WordsDelete = Replace(TextString, WordToDelete, vbNullString)
    End Function

    Public Function ToPositionWord(ByVal TextStrings As String, _
                                ByVal WordStrings As String, _
                                ByVal Direction As MFSStringsDirection, _
                       Optional ByVal IncludedWord As Boolean = True) As String
        Dim SystemLong As Long
        On Error Resume Next
        If Direction = MFSStringsDirection.ToRight Then
            SystemLong = InStr(1, TextStrings, WordStrings, vbTextCompare)
            If IncludedWord = False Then
                SystemLong = SystemLong - Len(WordStrings)
                ToPositionWord = Left(TextStrings, SystemLong)
            Else
                ToPositionWord = Left(TextStrings, SystemLong)
            End If
        ElseIf Direction = MFSStringsDirection.ToLeft Then
            TextStrings = StrReverse(TextStrings)
            WordStrings = StrReverse(WordStrings)
            SystemLong = InStr(1, TextStrings, WordStrings, 1)
            If IncludedWord = False Then
                SystemLong = SystemLong - Len(WordStrings)
                ToPositionWord = StrReverse(Left(TextStrings, SystemLong))
            Else
                ToPositionWord = StrReverse(Left(TextStrings, SystemLong))
            End If
        End If
    End Function

    ' Funciones de File System

    Public Function FreeFolderPath(ByVal InFolder As String, _
                                   Optional ByVal FolderName As String = "Tempo") As String
        Dim FSO As Object
        Dim Carpeta As Object, SubCarpeta As String, Man As Long
        FSO = CreateObject("Scripting.FileSystemObject")
        Carpeta = FSO.GetFolder(InFolder)
        If Err.Number <> Cero Then FreeFolderPath = vbNullString : Exit Function

        If Right(InFolder, Uno) = "\" Then
            SubCarpeta = InFolder & FolderName
        Else
            SubCarpeta = InFolder & "\" & FolderName
        End If

        Do Until FSO.FolderExists(SubCarpeta) = False
            Man = Man + Uno
            If Right(InFolder, Uno) = "\" Then
                SubCarpeta = InFolder & FolderName & Man
            Else
                SubCarpeta = InFolder & "\" & FolderName & Man
            End If
        Loop

        FreeFolderPath = SubCarpeta

    End Function

    Public Function FreeFilePath(ByVal InFolder As String, _
                                 Optional ByVal FileExtension As String = "Tmp", _
                                 Optional ByVal FileName As String = "TemporalFile") As String
        On Error Resume Next
        'Dim FSO As New Scripting.FileSystemObject
        'Dim Carpeta As Folder
        Dim Archivo As String, Man As Long
        'FSO = CreateObject("Scripting.FileSystemObject")
        'Carpeta = FSO.GetFolder(InFolder)
        'If Err.Number <> Cero Then FreeFilePath = vbNullString : Exit Function
        Man = 0
        If Right(InFolder, Uno) = "\" Then
            Archivo = InFolder & FileName & "." & FileExtension
        Else
            Archivo = InFolder & "\" & FileName & "." & FileExtension
        End If

        Do Until FSO.FileExists(Archivo) = False
            Man = Man + Uno
            If Right(InFolder, Uno) = "\" Then
                Archivo = InFolder & FileName & Man & "." & FileExtension
            Else
                Archivo = InFolder & "\" & FileName & Man & "." & FileExtension
            End If
        Loop

        FreeFilePath = Archivo

    End Function


    Public Function StringParentFolder(ByVal FileOrFolderPath As String) As String
        If FileOrFolderPath = vbNullString Then StringParentFolder = FileOrFolderPath : Exit Function
        If Len(FileOrFolderPath) < 4 Then StringParentFolder = FileOrFolderPath
        Dim Tempo As String
        Tempo = ToPositionWord(FileOrFolderPath, "\", MFSStringsDirection.ToLeft, True)
        StringParentFolder = Left(FileOrFolderPath, Len(FileOrFolderPath) - Len(Tempo))
    End Function

    Public Function FSOParent(ByVal FSOPath As String) As String
        On Error Resume Next

        If Len(FSOPath) < 4 Then
            FSOParent = FSOPath
            Exit Function
        End If

        Dim F As New FileSystemObject
        Dim D As Folder
        Dim A As File

        If FSOType(FSOPath) = MFSFileSystemObjectType.FileType Then
            A = F.GetFile(FSOPath)
            FSOParent = A.ParentFolder.Path
            If A.ParentFolder.Path = vbNullString Then
                FSOParent = A.Drive.Path
            End If
        ElseIf FSOType(FSOPath) = MFSFileSystemObjectType.FolderType Then
            D = F.GetFolder(FSOPath)
            FSOParent = D.ParentFolder.Path
            If D.ParentFolder.Path = vbNullString Then
                FSOParent = D.Drive.Path
            End If
        End If
        F = Nothing
        D = Nothing
        A = Nothing
    End Function

    Public Function FSOType(ByVal FSOPath As String) As MFSFileSystemObjectType
        On Error Resume Next
        If Len(FSOPath) < 4 And FSO.DriveExists(FSOPath) = True Then
            FSOType = MFSFileSystemObjectType.DriveType
            Exit Function
        End If

        ' Si existe el archivo es que no es un directorio
        If FSO.FileExists(FSOPath) = True Then
            FSOType = MFSFileSystemObjectType.FileType
            Exit Function
        ElseIf FSO.FolderExists(FSOPath) = True Then
            FSOType = MFSFileSystemObjectType.FolderType
            Exit Function
        End If

        FSOType = MFSFileSystemObjectType.NothingType
    End Function

    ' Funciones de Carpeta

    Public Function DriveExist(ByVal DrivePath As String) As Boolean
        On Error Resume Next
        Dim FSO As New FileSystemObject
        DriveExist = FSO.DriveExists(DrivePath)
    End Function

    Public Function FreeDriveLetter() As String
        On Error Resume Next
        Dim Man As Integer, T As String
        T = vbNullString
        For Man = 90 To 65 Step -1
            T = Chr(Man) & ":"
            If DriveExist(T) = False Then
                FreeDriveLetter = T
                Exit For
            End If
        Next
        Return T
    End Function

    Public Function CreateVirtualDrive(ByVal hWnd As Integer, ByVal FolderPath As String, _
                                   ByVal DriveLeter As String) As Boolean
        On Error Resume Next
        MFS.FileRunCommand(hWnd, "SUBST " & DriveLeter & ": " & Chr(34) & FolderPath & Chr(34))
    End Function

    Public Function DeleteVirtualDrive(ByVal hWnd As Integer, ByVal DriveLeter As String) As Boolean
        On Error Resume Next
        MFS.FileRunCommand(hWnd, "SUBST /D " & DriveLeter & ":")
    End Function

    Public Function RepairFolderPath(ByVal FolderPath As String) As String
        If Right(FolderPath, Uno) = ContraBarra Then
            RepairFolderPath = FolderPath
        Else
            RepairFolderPath = FolderPath & ContraBarra
        End If
    End Function

    Public Function SpecialDirectory(Optional ByVal TypeDirectory As MFSSpecialDirectory = MFSSpecialDirectory.UserDesktop) As String       ' Return Path of Special Directory
        On Error Resume Next

        Dim FSOS As Object
        Dim Tempo As Object
        Dim T As String

        FSOS = CreateObject("Scripting.FileSystemObject")
        Tempo = CreateObject("WScript.Shell")
        Select Case TypeDirectory
            Case MFSSpecialDirectory.WindowsDirectory
                SpecialDirectory = FSOS.GetSpecialFolder(0).Path
            Case MFSSpecialDirectory.System32Directory
                SpecialDirectory = FSOS.GetSpecialFolder(1).Path
            Case MFSSpecialDirectory.UserTemp
                SpecialDirectory = FSOS.GetSpecialFolder(2).Path
            Case MFSSpecialDirectory.RootDrivePath
                SpecialDirectory = Left(FSOS.GetSpecialFolder(0).Path, 3)
            Case MFSSpecialDirectory.ProgramFiles
                T = Environment.GetEnvironmentVariable("ProgramFiles")
                SpecialDirectory = T
            Case MFSSpecialDirectory.WindowsDirectory
                T = Environment.GetEnvironmentVariable("WinDir")
                SpecialDirectory = T
                'Case MFSSpecialDirectory.Cookies
                '    T = Environment.GetEnvironmentVariable("Cookies")
                '    SpecialDirectory = T
            Case MFSSpecialDirectory.UserRecent
                SpecialDirectory = Regedit.ReadKey("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Recent")
            Case MFSSpecialDirectory.UserFavorites
                SpecialDirectory = Regedit.ReadKey("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Favorites")
            Case MFSSpecialDirectory.UserMyPictures
                SpecialDirectory = Regedit.ReadKey("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Pictures")
            Case MFSSpecialDirectory.UserMyVideos
                SpecialDirectory = Regedit.ReadKey("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Video")
            Case MFSSpecialDirectory.UserMyMusic
                SpecialDirectory = Regedit.ReadKey("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Music")
            Case MFSSpecialDirectory.UserSendTo
                SpecialDirectory = Regedit.ReadKey("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SendTo")
            Case Else
                SpecialDirectory = Tempo.SpecialFolders(CInt(TypeDirectory))
        End Select

        FSOS = Nothing
        Tempo = Nothing
    End Function

    Public Function SpecialFolder(ByVal SPFolder As MFSSpecialFolder) As String
        On Error Resume Next
        Dim F As New FileSystemObject
        Dim Carpeta As Folder
        Carpeta = F.GetSpecialFolder(SpecialFolderConst.SystemFolder)
        If Err.Number <> 0 Then SpecialFolder = vbNullString : Exit Function
        Select Case SPFolder
            Case MFSSpecialFolder.SystemFolder
                Carpeta = F.GetSpecialFolder(SpecialFolderConst.SystemFolder)
            Case MFSSpecialFolder.TempFolder
                Carpeta = F.GetSpecialFolder(SpecialFolderConst.TemporaryFolder)
            Case MFSSpecialFolder.WindowsFolder
                Carpeta = F.GetSpecialFolder(SpecialFolderConst.WindowsFolder)
        End Select
        If Err.Number <> 0 Then SpecialFolder = vbNullString Else SpecialFolder = Carpeta.Path
    End Function

    Public Function FolderExist(ByVal FolderPath As String) As Boolean
        On Error Resume Next
        Dim F As New FileSystemObject
        FolderExist = F.FolderExists(FolderPath)
    End Function

    Public Function FolderName(ByVal FolderPath As String) As String
        On Error Resume Next

        Dim F As New FileSystemObject
        Dim Carpeta As Folder
        Carpeta = F.GetFolder(FolderPath)
        FolderName = Carpeta.Name
        Carpeta = Nothing
        F.GetFolder(Nothing)

    End Function

    Public Function SetFolderName(ByVal FolderPath As String, ByVal NewName As String) As String
        On Error Resume Next

        Dim F As New FileSystemObject
        Dim Carpeta As Folder
        Carpeta = F.GetFolder(FolderPath)
        Carpeta.Name = NewName
        Carpeta = Nothing
        F.GetFolder(Nothing)

    End Function

    Public Function FolderSizeBytes(ByVal FolderPath As String) As String
        On Error Resume Next

        Dim F As New FileSystemObject
        Dim Carpeta As Folder
        Carpeta = F.GetFolder(FolderPath)
        FolderSizeBytes = Carpeta.Size
        Carpeta = Nothing
        F.GetFolder(Nothing)

    End Function

    Public Function FolderFilesCount(ByVal FolderPath As String) As Long
        On Error Resume Next

        Dim F As New FileSystemObject
        Dim Carpeta As Folder
        Carpeta = F.GetFolder(FolderPath)
        FolderFilesCount = Carpeta.Files.Count
        Carpeta = Nothing
        F.GetFolder(Nothing)

    End Function

    Public Function FolderSubFoldersCount(ByVal FolderPath As String) As Long
        On Error Resume Next

        Dim F As New FileSystemObject
        Dim Carpeta As Folder
        Carpeta = F.GetFolder(FolderPath)
        FolderSubFoldersCount = Carpeta.SubFolders.Count
        Carpeta = Nothing
        F.GetFolder(Nothing)

    End Function

    Public Function FolderCreate(ByVal FolderPath As String) As Boolean
        FolderCreate = False
        On Error Resume Next
        Dim F As New FileSystemObject
        Dim Tempo As String
        Tempo = FolderPath
        Do Until F.FolderExists(Tempo) = False
            If Len(Tempo) < 4 Then Exit Do
            If F.FolderExists(Tempo) = False Then
                F.CreateFolder(Tempo)
                If Err.Number <> 0 Then
                    Tempo = StringParentFolder(Tempo)
                Else
                    FolderCreate = True
                    Exit Do
                End If
            Else
                Exit Do
            End If
        Loop
        F.CreateFolder(FolderPath)
    End Function


    Public Function FolderDelete(ByVal FolderPath As String) As Boolean
        On Error Resume Next
        FolderDelete = False
        Dim F As New FileSystemObject
        'If MFS.FSOType(FolderPath) = MFSFileSystemObjectType.FolderType Then
        F.DeleteFolder(FolderPath, True)
        If Err.Number <> 0 Then Exit Function
        FolderDelete = True
        'End If

    End Function
    ' Funciones de Archivos

    Public Function RunAndWaitToKill(ByVal FilePath As String) As Boolean
        On Error Resume Next
        Dim ObjWMIService As Object, ObjStartup As Object, ObjProcess As Object
        Dim ObjConfig As Object, IntReturn As Integer, IntProcessId As Integer
        Dim ColProcessStopTrace As Object, ObjLatestEvent As Object

        RunAndWaitToKill = False
        ObjWMIService = GetObject("winmgmts:" _
            & "{impersonationLevel=impersonate}!\\" _
            & "." & "\root\cimv2")

        ObjStartup = ObjWMIService.Get("Win32_ProcessStartup")
        ObjConfig = ObjStartup.SpawnInstance_

        ObjConfig.ShowWindow = Uno 'SW_NORMAL
        ObjProcess = ObjWMIService.Get("Win32_Process")

        IntReturn = ObjProcess.Create _
            (FilePath, vbNull, ObjConfig, IntProcessId)
        If IntReturn <> 0 Then
            Exit Function
        Else
            ColProcessStopTrace = ObjWMIService.ExecNotificationQuery _
                ("SELECT * FROM Win32_ProcessStopTrace")

            Do
                ObjLatestEvent = ColProcessStopTrace.NextEvent
                If ObjLatestEvent.ProcessId = IntProcessId Then
                    Exit Do
                End If
            Loop
        End If

        ObjWMIService = Nothing
        ObjStartup = Nothing
        ObjConfig = Nothing
        ObjProcess = Nothing
        ColProcessStopTrace = Nothing
        ObjLatestEvent = Nothing

        RunAndWaitToKill = True

    End Function

    Public Function FileExecute(ByVal FilePath As String) As Boolean
        On Error Resume Next
        FileExecute = False
        If Shell(FilePath, AppWinStyle.NormalFocus) <> 0 Then
            FileExecute = True
        Else
            FileExecute = False
        End If
    End Function

    Public Function FileName(ByVal FilePath As String, Optional ByVal NameAndExtension As Boolean = True) As String
        On Error Resume Next
        FileName = vbNullString
        Dim FSO As New FileSystemObject
        Dim Tempo As String

        Tempo = FSO.GetFileName(FilePath)

        If NameAndExtension = True Then
            FileName = Tempo
        Else
            FileName = Left(Tempo, Len(Tempo) - (Len(FileExtension(FilePath)) + 1))
        End If

    End Function

    Public Sub SetFileName(ByVal FilePath As String, ByVal NameAndExtension As String)
        On Error Resume Next
        Dim FSO As New FileSystemObject
        Dim Tempo As File

        Tempo = FSO.GetFile(FilePath)
        Tempo.Name = NameAndExtension

        Tempo = Nothing
    End Sub

    Public Function FileRunCommand(ByVal hWnd As Integer, ByVal CommandToRun As String) As Boolean
        On Error Resume Next
        FileRunCommand = False
        If CommandToRun = vbNullString Then Exit Function
        'If ShellExecute(hWnd, "OPEN", FilePath, vbNullString, vbNullString, 1) <> 0 Then
        'FileRun = True
        'End If
        Dim TempoPath As String, TempoFolder As String, TempoData As String

        TempoFolder = SpecialDirectory(MFSSpecialDirectory.UserTemp)
        TempoPath = FreeFilePath(TempoFolder, "bat")
        TempoData = "@echo off" & vbCrLf & CommandToRun

        FileWriteData(TempoPath, TempoData)
        FileExecute(TempoPath)
        FileRunCommand = True

        'FileDelete(TempoPath)
    End Function


    Public Function FileShellRunFile(ByVal FilePath As String) As Boolean
        On Error Resume Next
        FileShellRunFile = False
        If FilePath = vbNullString Then Exit Function
        If MFS.FileExecute(FilePath) = True Then
            FileShellRunFile = True
        End If

    End Function



    Public Function FileIsImage(ByVal FilePath As String) As Boolean
        FileIsImage = False

        If FileExist(FilePath) = True Then
            If LCase(FileExtension(FilePath)) = "bmp" Or _
               LCase(FileExtension(FilePath)) = "jpg" Or _
               LCase(FileExtension(FilePath)) = "jpeg" Or _
               LCase(FileExtension(FilePath)) = "gif" Or _
               LCase(FileExtension(FilePath)) = "png" Then
                FileIsImage = True
            End If
        End If

    End Function

    Public Function FileIsAudio(ByVal FilePath As String) As Boolean
        FileIsAudio = False

        If FileExist(FilePath) = True Then
            If LCase(FileExtension(FilePath)) = "wav" Or _
               LCase(FileExtension(FilePath)) = "wma" Or _
               LCase(FileExtension(FilePath)) = "mka" Or _
               LCase(FileExtension(FilePath)) = "mp3" Then 'Or _
                'LCase(FileExtension(FilePath)) = "mp2" Then
                FileIsAudio = True
            End If
        End If

    End Function

    Public Function FileIsVideo(ByVal FilePath As String) As Boolean
        FileIsVideo = False

        If FileExist(FilePath) = True Then
            If LCase(FileExtension(FilePath)) = "dat" Or _
               LCase(FileExtension(FilePath)) = "avi" Or _
               LCase(FileExtension(FilePath)) = "mpg" Or _
               LCase(FileExtension(FilePath)) = "mpeg" Or _
               LCase(FileExtension(FilePath)) = "divx" Or _
               LCase(FileExtension(FilePath)) = "wmv" Or _
               LCase(FileExtension(FilePath)) = "mp4" Or _
               LCase(FileExtension(FilePath)) = "mkv" Then
                FileIsVideo = True
            End If
        End If

    End Function

    Public Function FileIsText(ByVal FilePath As String) As Boolean
        FileIsText = False

        If FileExist(FilePath) = True Then
            If LCase(FileExtension(FilePath)) = "txt" Or _
               LCase(FileExtension(FilePath)) = "ini" Or _
               LCase(FileExtension(FilePath)) = "inf" Or _
               LCase(FileExtension(FilePath)) = "html" Or _
               LCase(FileExtension(FilePath)) = "vb" Or _
               LCase(FileExtension(FilePath)) = "log" Or _
               LCase(FileExtension(FilePath)) = "xml" Or _
               LCase(FileExtension(FilePath)) = "vbs" Or _
               LCase(FileExtension(FilePath)) = "js" Or _
               LCase(FileExtension(FilePath)) = "php" Then
                FileIsText = True
            End If
        End If

    End Function

    Public Function FileIsRichText(ByVal FilePath As String) As Boolean
        FileIsRichText = False

        If FileExist(FilePath) = True Then
            If LCase(FileExtension(FilePath)) = "rtf" Then
                FileIsRichText = True
            End If
        End If

    End Function

    Public Function FileIsPDF(ByVal FilePath As String) As Boolean
        FileIsPDF = False

        If FileExist(FilePath) = True Then
            If LCase(FileExtension(FilePath)) = "pdf" Then
                FileIsPDF = True
            End If
        End If

    End Function

    Public Function FileIsZIP(ByVal FilePath As String) As Boolean
        FileIsZIP = False

        If FileExist(FilePath) = True Then
            If LCase(FileExtension(FilePath)) = "zip" Then
                FileIsZIP = True
            End If
        End If

    End Function

    Public Function FileExtension(ByVal FilePath As String) As String
        On Error Resume Next
        Dim F As New FileSystemObject
        FileExtension = F.GetExtensionName(FilePath)
    End Function

    Public Function FileExist(ByVal FilePath As String) As Boolean
        On Error Resume Next
        Dim F As New FileSystemObject
        FileExist = F.FileExists(FilePath)
    End Function

    Public Function FileRemove(ByVal FilePath() As String) As Boolean
        On Error Resume Next
        FileRemove = False
        Dim SHFileOp As New SHFILEOPSTRUCT
        Dim Ret As Integer
        Static Tempo As String
        Static SubTempo As String
        SubTempo = vbNullString
        For Each Tempo In FilePath
            SubTempo = SubTempo & Tempo & vbNullChar
        Next

        With SHFileOp
            .wFunc = FO_DELETE
            .pFrom = SubTempo & vbNullChar
            .fFlags = FOF_ALLOWUNDO
        End With

        Ret = SHFileOperation(SHFileOp)
        If Ret = 0 Then FileRemove = True
    End Function

    Public Function FileDelete(ByVal FilePath As String) As Boolean
        On Error Resume Next
        Dim F As New FileSystemObject
        F.DeleteFile(FilePath, True)
        If Err.Number = 0 Then FileDelete = True
        'MsgBox(Err.Number, MsgBoxStyle.Critical, Err.Description)
    End Function

    Public Function FileWriteData(ByVal FilePath As String, ByVal FileData As String) As Boolean
        On Error Resume Next
        FileDelete(FilePath)
        Dim NumFile As Integer

        FileWriteData = False

        NumFile = vb.FileSystem.FreeFile
        vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Write, OpenShare.Shared)
        vb.FileSystem.FilePut(NumFile, FileData)
        vb.FileSystem.FileClose()

        If Err.Number = 0 Then
            FileWriteData = True
        End If

    End Function

    Public Function FileINIReadListObjects(ByVal FilePath As String) As MFSFileINIDataList
        On Error Resume Next
        Static NumFile As Integer, LineData As String, Man As Integer
        ReDim FileINIReadListObjects.LineItem(1)
        FileINIReadListObjects.LinesCount = 0

        With FileINIReadListObjects
            NumFile = vb.FileSystem.FreeFile
            vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Input, OpenAccess.Read, OpenShare.Shared)
            If Err.Number <> 0 Then Exit Function
            Do Until vb.FileSystem.EOF(NumFile) = True
                Err.Clear()
                LineData = vbNullString
                LineData = vb.FileSystem.LineInput(NumFile)
                If Err.Number <> 0 Then Exit Do
                If LineData <> vbNullString Then
                    If vb.Left(LineData, 1) = "[" And vb.Right(LineData, 1) = "]" Then
                        ReDim Preserve .LineItem(.LinesCount)
                        .LineItem(.LinesCount) = LineData
                        .LinesCount = .LinesCount + 1
                    End If
                End If
            Loop
        End With
        vb.FileSystem.FileClose(NumFile)

    End Function

    Public Function FileINIReadListData(ByVal FilePath As String, _
                           Optional ByVal NamedColumn As String = "autorun") As MFSFileINIDataList
        On Error Resume Next
        Static NumFile As Integer, LineData As String, Man As Integer
        ReDim FileINIReadListData.LineItem(1)
        FileINIReadListData.LinesCount = 0

        With FileINIReadListData
            NumFile = vb.FileSystem.FreeFile
            vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Input, OpenAccess.Read, OpenShare.Shared)
            If Err.Number <> 0 Then Exit Function
            Do Until vb.FileSystem.EOF(NumFile) = True
                LineData = vbNullString
                LineData = vb.FileSystem.LineInput(NumFile)

                If LCase(Left(LineData, 1)) = "[" And LCase(Right(LineData, 1)) = "]" And LCase(LineData) = "[" & LCase(NamedColumn) & "]" Then
                    Do Until vb.FileSystem.EOF(NumFile) = True
                        LineData = vbNullString
                        LineData = vb.FileSystem.LineInput(NumFile)
                        If LineData = vbNullString Then Exit Do
                        If LCase(Left(LineData, 1)) = "[" And LCase(Right(LineData, 1)) = "]" Then Exit Do
                        .LinesCount = .LinesCount + 1
                    Loop
                    Exit Do
                End If
            Loop
        End With
        vb.FileSystem.FileClose(NumFile)

        If FileINIReadListData.LinesCount = 0 Then Exit Function

        'ReDim FileINIReadListData.LineItem(FileINIReadListData.LinesCount - 1)
        ReDim FileINIReadListData.LineItem(FileINIReadListData.LinesCount)
        NumFile = vb.FileSystem.FreeFile
        vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Input, OpenAccess.Read, OpenShare.Shared)
        Do Until vb.FileSystem.EOF(NumFile) = True
            LineData = vbNullString
            LineData = vb.FileSystem.LineInput(NumFile)
            If Left(LineData, 1) = "[" And Right(LineData, 1) = "]" And LCase(LineData) = "[" & LCase(NamedColumn) & "]" Then
                With FileINIReadListData
                    Man = 0
                    Do Until vb.FileSystem.EOF(NumFile) = True
                        LineData = vbNullString
                        LineData = vb.FileSystem.LineInput(NumFile)
                        If LineData = vbNullString Then Exit Do
                        If Left(LineData, 1) = "[" And Right(LineData, 1) = "]" Then Exit Do
                        .LineItem(Man) = LineData
                        Man = Man + 1
                    Loop
                End With
                Exit Do
            End If
        Loop
        vb.FileSystem.FileClose(NumFile)

    End Function

    Public Function FileReadData(ByVal FilePath As String) As String
        On Error Resume Next
        Dim NumFile As Integer, Datos As String, SubDatos As String
        Dim Man As Long, LenghtTempo As Long, LongitudSP As Integer

        FileReadData = vbNullString

        Datos = vbNullString

        NumFile = vb.FileSystem.FreeFile
        FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
        If Err.Number <> 0 Then Exit Function
        SubDatos = vbNullString
        LenghtTempo = LOF(NumFile)

        If LenghtTempo > 50000 Then
            For Man = 1 To LenghtTempo Step 50000
                LongitudSP = LenghtTempo - Man
                If LongitudSP < 50000 Then
                    Datos = Datos & Space(LongitudSP)
                    FileGet(NumFile, Datos)
                    SubDatos = SubDatos & Datos
                    Exit For
                Else
                    Datos = Datos & Space(50000)
                    FileGet(NumFile, Datos)
                    SubDatos = SubDatos & Datos
                End If
            Next
        Else
            Datos = Datos & Space(LenghtTempo)
            FileGet(NumFile, Datos)
            SubDatos = Datos
        End If

        FileReadData = SubDatos
        vb.FileSystem.FileClose()
    End Function

    Public Function FileWriteDataSheets3(ByVal FilePath As String, ByRef DataSheets As MFSFileDataSheetsColumn) As Boolean
        On Error Resume Next
        FileWriteDataSheets3 = False

        Dim NumFile As Integer
        Dim Man As Long
        Dim SubMan As Long
        Dim ColumnsCount As Long
        Dim LenghtTempo As Integer
        Dim ItemsCount As Long, Tempo As String

        NumFile = FreeFile()
        vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Write, OpenShare.LockWrite)
        If Err.Number <> 0 Then MsgBox(Err.Description, MsgBoxStyle.Critical, Err.Number) : vb.FileSystem.FileClose(NumFile) : Exit Function

        vb.FileSystem.Seek(NumFile, 1)
        vb.FileSystem.FilePut(NumFile, Title3)

        ColumnsCount = UBound(DataSheets.Column) + 1
        vb.FileSystem.FilePut(NumFile, ColumnsCount)

        ItemsCount = UBound(DataSheets.Column(1).Item) + 1
        vb.FileSystem.FilePut(NumFile, ItemsCount)

        'If ColumnsCount < 1 Then vb.FileSystem.FileClose() : Exit Function
        'If ItemsCount < 1 Then vb.FileSystem.FileClose() : Exit Function

        'If Err.Number <> 0 Then vb.FileSystem.FileClose(NumFile) : Exit Function

        For Man = LBound(DataSheets.Column) To UBound(DataSheets.Column)
            For SubMan = LBound(DataSheets.Column(Man).Item) To UBound(DataSheets.Column(Man).Item)
                Tempo = vbNullString
                Tempo = DataSheets.Column(Man).Item(SubMan)
                LenghtTempo = Len(Tempo)
                vb.FileSystem.FilePut(NumFile, LenghtTempo)
                If Tempo <> vbNullString Then
                    vb.FileSystem.FilePut(NumFile, Tempo)
                End If
            Next
        Next

        vb.FileSystem.FileClose(NumFile)

        FileWriteDataSheets3 = True
    End Function

    Public Function FileWriteDataSheets(ByVal FilePath As String, ByRef DataSheets As MFSFileDataSheetsColumn) As Boolean
        On Error Resume Next
        FileWriteDataSheets = False

        Dim NumFile As Integer, Man, SubMan As Integer
        Dim ColumnsCount As Integer, LenghtTempo As Integer
        Dim ItemsCount As Integer, Tempo As String

        NumFile = FreeFile()
        vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Write, OpenShare.LockWrite)
        If Err.Number <> 0 Then MsgBox(Err.Description, MsgBoxStyle.Critical, Err.Number) : vb.FileSystem.FileClose(NumFile) : Exit Function

        vb.FileSystem.Seek(NumFile, 1)
        vb.FileSystem.FilePut(NumFile, Title)

        ColumnsCount = UBound(DataSheets.Column) + 1
        vb.FileSystem.FilePut(NumFile, ColumnsCount)

        ItemsCount = UBound(DataSheets.Column(1).Item) + 1
        vb.FileSystem.FilePut(NumFile, ItemsCount)

        'If ColumnsCount < 1 Then vb.FileSystem.FileClose() : Exit Function
        'If ItemsCount < 1 Then vb.FileSystem.FileClose() : Exit Function

        'If Err.Number <> 0 Then vb.FileSystem.FileClose(NumFile) : Exit Function

        For Man = LBound(DataSheets.Column) To UBound(DataSheets.Column)
            For SubMan = LBound(DataSheets.Column(Man).Item) To UBound(DataSheets.Column(Man).Item)
                Tempo = vbNullString
                Tempo = DataSheets.Column(Man).Item(SubMan)
                LenghtTempo = Len(Tempo)
                vb.FileSystem.FilePut(NumFile, LenghtTempo)
                If Tempo <> vbNullString Then
                    vb.FileSystem.FilePut(NumFile, Tempo)
                End If
            Next
        Next

        vb.FileSystem.FileClose(NumFile)

        FileWriteDataSheets = True
    End Function

    Public Function FileReadIsEncripted(ByVal FilePathToDencript As String) As Boolean
        On Error Resume Next
        FileReadIsEncripted = False
        If LCase(MFS.FileExtension(FilePathToDencript)) <> "cdp" Then
            Exit Function
        End If
        Dim Tempo, Subtempo As String
        Dim NumFile As Integer
        NumFile = vb.FileSystem.FreeFile
        vb.FileSystem.FileOpen(NumFile, FilePathToDencript, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
        If Err.Number <> 0 Then Exit Function
        Tempo = vb.FileSystem.InputString(NumFile, Len(TitleEncript))
        If LCase(Tempo) <> LCase(TitleEncript) Then
            vb.FileSystem.FileClose(NumFile)
            Exit Function
        End If
        vb.FileSystem.FileClose(NumFile)
        FileReadIsEncripted = True
    End Function

    Public Function FileReadEncriptedData(ByVal FilePathToDecodify As String, Optional ByVal PassWord As String = vbNullString) As String
        On Error Resume Next
        FileReadEncriptedData = vbNullString
        Dim Tempo, SubTempo As String
        Dim OTempo As String
        Dim NumFile As Integer
        Dim TempoPath, SubTempoPath As String
        Dim FinalPath As String, FinalDatos As String
        Dim Man As Integer, SubTexto As String, TextoLen As Long

        If MFS.FileReadIsEncripted(FilePathToDecodify) = False Then MsgBox("Error de Archivo", MsgBoxStyle.Critical, "No es un archivo codificado") : FileReadEncriptedData = vbNullString : Exit Function

        Err.Clear()
        NumFile = vb.FileSystem.FreeFile
        vb.FileSystem.FileOpen(NumFile, FilePathToDecodify, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
        If Err.Number <> 0 Then
            MsgBox("No se puede leer al archivo de origen...", MsgBoxStyle.Critical, "Error de lectura")
            Exit Function
        End If

        Tempo = vb.FileSystem.InputString(NumFile, Len(TitleEncript))

        If LCase(Tempo) <> LCase(TitleEncript) Then
            vb.FileSystem.FileClose(NumFile)
            MsgBox("El archivo no esta codificado...", MsgBoxStyle.Critical, "Error de lectura")
            Exit Function
        End If

        SubTempo = vb.FileSystem.InputString(NumFile, SecurityModule.LenSecureString)

        SubTexto = "Introduzca aqui la Contraseņa del Archivo:"
        If PassWord = vbNullString Then
            For Man = 0 To 2
                Tempo = InputBox(SubTexto, "Contraseņa", vbNullString)
                If Tempo = vbNullString Then
                    MsgBox("Cancelado por el usuario", MsgBoxStyle.Critical, "Cancelado")
                    Exit Function
                End If
                If Tempo = SecurityModule.ReadSecureString(SubTempo) Then Exit For
                If Man = 2 Then MsgBox("Ha superado el numero de intentos para la contraseņa...", MsgBoxStyle.Critical, "Numero de intentos superado") : Exit For : Exit Function
                SubTexto = "Contraseņa incorrecta, Introduzca aqui la Contraseņa del Archivo:"
            Next
        Else
            Tempo = PassWord
        End If

        If Tempo <> SecurityModule.ReadSecureString(SubTempo) Then
            MsgBox("Contraseņa incorrecta", MsgBoxStyle.Critical, "Contraseņa incorrecta")
            Exit Function
        End If

        Tempo = vb.FileSystem.InputString(NumFile, CInt(SecurityModule.LenSecureString))

        OTempo = SecurityModule.ReadSecureString(Tempo)

        Dim SubDatos As String, LenghtTempo As Long, LongitudSP As Integer, Datos As String

        TextoLen = LOF(NumFile) - (Len(TitleEncript) + (SecurityModule.LenSecureString * 2))
        Datos = vbNullString
        SubDatos = vbNullString
        LenghtTempo = TextoLen
        For Man = 1 To LenghtTempo Step 32000
            LongitudSP = LenghtTempo - Man
            If LongitudSP < 32000 Then
                Datos = Datos & Space(LongitudSP)
                FileGet(NumFile, Datos)
                SubDatos = SubDatos & Datos
                Exit For
            Else
                Datos = Datos & Space(32000)
                FileGet(NumFile, Datos)
                SubDatos = SubDatos & Datos
            End If
        Next
        Tempo = SubDatos

        TempoPath = MFS.RepairFolderPath(MFS.FSOParent(FilePathToDecodify))
        SubTempoPath = MFS.FileName(FilePathToDecodify, False)

        'FinalPath = TempoPath & SubTempoPath & "." & OTempo
        FinalPath = MFS.FreeFilePath(TempoPath, OTempo, SubTempoPath)

        FinalDatos = SecurityModule.DeCodifyString(Tempo)
        MFS.FileWriteData(FinalPath, FinalDatos)

        'If MFS.FileWriteData(FinalPath, SecurityModule.DeCodifyString(Tempo)) = False Then
        'vb.FileSystem.FileClose(NumFile)
        'MsgBox("No se pudo crear el archivo Original.", MsgBoxStyle.Critical, "Error al crear el archivo")
        'Exit Function
        'End If

        vb.FileSystem.FileClose(NumFile)
        FileReadEncriptedData = FinalPath

    End Function

    Public Function CreateShortcut(ByVal FilePath As String, ByVal ExecutableFilePath As String, ByVal FileDescription As String) As Boolean
        On Error Resume Next

        Dim WshShell As Object, StrDesktop As String, oShellLink As Object

        WshShell = CreateObject("WScript.Shell")
        StrDesktop = MFS.StringParentFolder(FilePath)  ' WshShell.SpecialFolders("Desktop")
        oShellLink = WshShell.CreateShortcut(FilePath)
        oShellLink.TargetPath = ExecutableFilePath
        oShellLink.WindowStyle = 1
        'oShellLink.Hotkey = "CTRL+SHIFT+F"
        oShellLink.IconLocation = ExecutableFilePath & ", 0"
        oShellLink.Description = FileDescription
        oShellLink.WorkingDirectory = StrDesktop
        oShellLink.Save()

    End Function




    Public Function FileWriteEncriptedData(ByVal FilePathToEncript As String, ByVal PassWord As String) As String
        On Error Resume Next
        FileWriteEncriptedData = vbNullString

        Dim Tempo, SubTempo As String
        Dim TempoPath, SubTempoPath, FinalPath As String
        Dim TempoData As String, Man As Integer
        Dim TempoDatos As String, SubTempoDatos As String
        Tempo = vbNullString
        SubTempo = vbNullString


        If PassWord = vbNullString Then
            For Man = 0 To 2
                Tempo = InputBox("Introduzca una contraseņa para el archivo:", "Contraseņa")
                If Tempo <> vbNullString Then Exit For
                If Tempo = vbNullString Then MsgBox("Cancelado por el usuario...", MsgBoxStyle.Critical, "Cancelado") : Exit For : Exit Function
            Next
            If Tempo = vbNullString Then Exit Function

            SubTempo = SecurityModule.WriteSecureString(Tempo)
        Else
            SubTempo = SecurityModule.WriteSecureString(PassWord)
        End If

        Tempo = SecurityModule.WriteSecureString(MFS.FileExtension(FilePathToEncript))

        SubTempoDatos = MFS.FileReadData(FilePathToEncript)
        TempoDatos = SecurityModule.CodifyString(SubTempoDatos)
        TempoData = TitleEncript & SubTempo & Tempo & TempoDatos

        TempoPath = MFS.RepairFolderPath(MFS.FSOParent(FilePathToEncript))
        SubTempoPath = MFS.FileName(FilePathToEncript, False)

        ' Abrebiatura de Codify Document Pol

        'FinalPath = TempoPath & SubTempoPath & ".cdp"
        FinalPath = MFS.FreeFilePath(TempoPath, "cdp", SubTempoPath)

        'If MFS.FileWriteData(FinalPath, TempoData) = False Then
        'Exit Function
        'End If

        MFS.FileWriteData(FinalPath, TempoData)

        FileWriteEncriptedData = FinalPath

    End Function

    Public Function FileReadIsDataSheets(ByVal FilePath As String) As Boolean
        FileReadIsDataSheets = False
        On Error Resume Next
        If vb.FileSystem.FileLen(FilePath) < Len(Title) Then Exit Function

        Dim NumFile As Integer, Man As Integer, SubMan As Integer
        'Dim ColumnsCount As Integer, LenghtTempo As Long
        'Dim ItemsCount As Integer, TempoMan As Integer
        Dim Tempo As Char, SubTempo As String

        NumFile = FileSystem.FreeFile()
        vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
        If Err.Number <> 0 Then Exit Function
        SubTempo = vb.FileSystem.InputString(NumFile, Len(Title))
        If LCase(SubTempo) <> LCase(Title) Then
            vb.FileSystem.FileClose(NumFile)
            Exit Function
        End If
        vb.FileSystem.FileClose()
        FileReadIsDataSheets = True

    End Function

    Public Function FileReadIsDataSheets3(ByVal FilePath As String) As Boolean
        FileReadIsDataSheets3 = False
        On Error Resume Next
        If vb.FileSystem.FileLen(FilePath) < Len(Title3) Then Exit Function

        Dim NumFile As Integer, Man As Integer, SubMan As Integer
        'Dim ColumnsCount As Integer, LenghtTempo As Long
        'Dim ItemsCount As Integer, TempoMan As Integer
        Dim Tempo As Char, SubTempo As String

        NumFile = FileSystem.FreeFile()
        vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
        If Err.Number <> 0 Then Exit Function
        SubTempo = vb.FileSystem.InputString(NumFile, Len(Title3))
        If LCase(SubTempo) <> LCase(Title3) Then
            vb.FileSystem.FileClose(NumFile)
            Exit Function
        End If
        vb.FileSystem.FileClose()
        FileReadIsDataSheets3 = True

    End Function

    Public Function FileReadDataSheets(ByVal FilePath As String) As MFSFileDataSheetsColumn
        On Error Resume Next
        ReDim FileReadDataSheets.Column(0)
        ReDim Preserve FileReadDataSheets.Column(0).Item(0)

        If vb.FileSystem.FileLen(FilePath) < Len(Title) Then FileReadDataSheets.Column(0).Item.SetValue(vbNullString, 0) : Exit Function


        Dim NumFile As Integer, Man, SubMan As Integer
        Dim ColumnsCount As Integer, LenghtTempo As Integer
        Dim ItemsCount As Integer
        Dim SubTempo As String
        ColumnsCount = -1
        ItemsCount = -1
        With FileReadDataSheets
            NumFile = vb.FileSystem.FreeFile
            vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
            'If Err.Number <> 0 Then Exit Function
            SubTempo = vb.FileSystem.InputString(NumFile, Len(Title))
            If LCase(SubTempo) <> LCase(Title) Then
                vb.FileSystem.FileClose(NumFile)
                Exit Function
            End If

            vb.FileSystem.FileGet(NumFile, ColumnsCount)
            vb.FileSystem.FileGet(NumFile, ItemsCount)
            If ColumnsCount < 1 Then
                vb.FileSystem.FileClose(NumFile)
                Exit Function
            End If

            If ItemsCount < 1 Then
                vb.FileSystem.FileClose(NumFile)
                Exit Function
            End If

            ReDim Preserve FileReadDataSheets.Column(ColumnsCount - 1)
            For Man = 0 To ColumnsCount - 1
                ReDim Preserve FileReadDataSheets.Column(Man).Item(ItemsCount - 1)
                For SubMan = 0 To ItemsCount - 1
                    SubTempo = vbNullString
                    vb.FileSystem.FileGet(NumFile, LenghtTempo)
                    If LenghtTempo > 0 Then
                        SubTempo = vb.FileSystem.InputString(NumFile, LenghtTempo)
                        FileReadDataSheets.Column(Man).Item(SubMan) = SubTempo.Clone
                    Else
                        FileReadDataSheets.Column(Man).Item(SubMan) = vbNullString
                    End If
                Next
            Next

            vb.FileSystem.FileClose(NumFile)

        End With

    End Function

    Public Function FileReadDataSheets3(ByVal FilePath As String) As MFSFileDataSheetsColumn
        On Error Resume Next
        ReDim FileReadDataSheets3.Column(0)
        ReDim Preserve FileReadDataSheets3.Column(0).Item(0)

        If vb.FileSystem.FileLen(FilePath) < Len(Title3) Then FileReadDataSheets3.Column(0).Item.SetValue(vbNullString, 0) : Exit Function


        Dim NumFile As Integer
        Dim Man As Long
        Dim SubMan As Long
        Dim ColumnsCount As Long
        Dim LenghtTempo As Integer
        Dim ItemsCount As Long
        Dim SubTempo As String
        ColumnsCount = -1
        ItemsCount = -1

        NumFile = vb.FileSystem.FreeFile
        vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
        'If Err.Number <> 0 Then Exit Function
        SubTempo = vb.FileSystem.InputString(NumFile, Len(Title3))
        If LCase(SubTempo) <> LCase(Title3) Then
            vb.FileSystem.FileClose(NumFile)
            Exit Function
        End If

        vb.FileSystem.FileGet(NumFile, ColumnsCount)
        vb.FileSystem.FileGet(NumFile, ItemsCount)
        If ColumnsCount < 1 Then
            vb.FileSystem.FileClose(NumFile)
            Exit Function
        End If

        If ItemsCount < 1 Then
            vb.FileSystem.FileClose(NumFile)
            Exit Function
        End If

        ReDim Preserve FileReadDataSheets3.Column(ColumnsCount - 1)
        For Man = 0 To ColumnsCount - 1
            ReDim Preserve FileReadDataSheets3.Column(Man).Item(ItemsCount - 1)
            For SubMan = 0 To ItemsCount - 1
                SubTempo = vbNullString
                vb.FileSystem.FileGet(NumFile, LenghtTempo)
                If LenghtTempo > 0 Then
                    SubTempo = vb.FileSystem.InputString(NumFile, LenghtTempo)
                    FileReadDataSheets3.Column(Man).Item(SubMan) = SubTempo.Clone
                Else
                    FileReadDataSheets3.Column(Man).Item(SubMan) = vbNullString
                End If
            Next
        Next

        vb.FileSystem.FileClose(NumFile)

    End Function


    Public Function FileReadDataSheets2(ByVal FilePath As String) As MFSFileDataSheetsColumn
        On Error Resume Next
        ReDim FileReadDataSheets2.Column(0)
        ReDim Preserve FileReadDataSheets2.Column(0).Item(0)
        If vb.FileSystem.FileLen(FilePath) <= Len(Title2) Then FileReadDataSheets2.Column(0).Item.SetValue(vbNullString, 0) : Exit Function

        Dim NumFile As Integer, Man, SubMan, SubMan2 As Long
        Dim ColumnsCount As Long, LenghtTempo As Long
        Dim ItemsCount As Long
        Dim SubTempo As String
        ColumnsCount = -1
        ItemsCount = -1
        With FileReadDataSheets2
            NumFile = vb.FileSystem.FreeFile
            vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
            'If Err.Number <> 0 Then Exit Function
            SubTempo = Title2
            vb.FileSystem.FileGet(NumFile, SubTempo)
            If LCase(SubTempo) <> LCase(Title2) Then
                vb.FileSystem.FileClose(NumFile)
                Exit Function
            End If

            vb.FileSystem.FileGet(NumFile, ColumnsCount)
            vb.FileSystem.FileGet(NumFile, ItemsCount)
            If ColumnsCount < 1 Then
                vb.FileSystem.FileClose(NumFile)
                Exit Function
            End If

            If ItemsCount < 1 Then
                vb.FileSystem.FileClose(NumFile)
                Exit Function
            End If

            ReDim Preserve FileReadDataSheets2.Column(ColumnsCount - 1)
            For Man = 0 To ColumnsCount - 1
                ReDim Preserve FileReadDataSheets2.Column(Man).Item(ItemsCount - 1)
                For SubMan = 0 To ItemsCount - 1
                    SubTempo = vbNullString
                    vb.FileSystem.FileGet(NumFile, LenghtTempo)
                    If LenghtTempo > 0 Then
                        For SubMan2 = 1 To LenghtTempo Step 32000
                            If LenghtTempo < 32000 Then
                                SubTempo = Space(LenghtTempo)
                                Exit For
                            Else
                                If LenghtTempo - SubMan2 < 32000 Then
                                    SubTempo = SubTempo & Space(LenghtTempo - (SubMan2 - 1))
                                    Exit For
                                Else
                                    SubTempo = SubTempo & Space(32000)
                                End If

                            End If
                        Next
                        vb.FileSystem.FileGet(NumFile, SubTempo)
                        FileReadDataSheets2.Column(Man).Item(SubMan) = SubTempo
                    Else
                        FileReadDataSheets2.Column(Man).Item(SubMan) = vbNullString
                    End If
                Next
            Next

            vb.FileSystem.FileClose(NumFile)

        End With

    End Function


    Public Function FileWriteDataSheets2(ByVal FilePath As String, ByRef DataSheets As MFSFileDataSheetsColumn) As Boolean
        On Error Resume Next
        FileDelete(FilePath)

        FileWriteDataSheets2 = False

        Dim NumFile As Integer, Man, SubMan As Long
        Dim ColumnsCount As Long, LenghtTempo As Long
        Dim ItemsCount As Long, Tempo As String

        Err.Clear()
        NumFile = FreeFile()
        vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Write, OpenShare.Shared)
        If Err.Number <> 0 Then MsgBox(Err.Description, MsgBoxStyle.Critical, Err.Number) : vb.FileSystem.FileClose(NumFile) : Exit Function

        vb.FileSystem.Seek(NumFile, 1)
        vb.FileSystem.FilePut(NumFile, Title2)

        ColumnsCount = UBound(DataSheets.Column) + 1
        vb.FileSystem.FilePut(NumFile, ColumnsCount)

        ItemsCount = UBound(DataSheets.Column(1).Item) + 1
        vb.FileSystem.FilePut(NumFile, ItemsCount)

        If ColumnsCount < 1 Then vb.FileSystem.FileClose() : Exit Function
        If ItemsCount < 1 Then vb.FileSystem.FileClose() : Exit Function

        'If Err.Number <> 0 Then vb.FileSystem.FileClose(NumFile) : Exit Function

        For Man = LBound(DataSheets.Column) To UBound(DataSheets.Column)
            For SubMan = LBound(DataSheets.Column(Man).Item) To UBound(DataSheets.Column(Man).Item)
                Tempo = DataSheets.Column(Man).Item(SubMan)
                LenghtTempo = Len(Tempo)
                vb.FileSystem.FilePut(NumFile, LenghtTempo)
                If Tempo <> vbNullString Then
                    vb.FileSystem.FilePut(NumFile, Tempo)
                End If
            Next
        Next

        vb.FileSystem.FileClose(NumFile)

        FileWriteDataSheets2 = True
    End Function

    Public Function FileReadIsDataSheets2(ByVal FilePath As String) As Boolean
        FileReadIsDataSheets2 = False
        On Error Resume Next
        If vb.FileSystem.FileLen(FilePath) < Len(Title2) Then Exit Function

        Dim NumFile As Integer
        'Dim ColumnsCount As Integer, LenghtTempo As Long
        'Dim ItemsCount As Integer, TempoMan As Integer
        Dim Tempo As Char, SubTempo As String

        NumFile = FileSystem.FreeFile()
        vb.FileSystem.FileOpen(NumFile, FilePath, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
        If Err.Number <> 0 Then Exit Function
        SubTempo = vb.FileSystem.InputString(NumFile, Len(Title2))
        If LCase(SubTempo) <> LCase(Title2) Then
            vb.FileSystem.FileClose(NumFile)
            Exit Function
        End If
        vb.FileSystem.FileClose()
        FileReadIsDataSheets2 = True

    End Function

    Public Function FolderFilesCountByExtension(ByVal FolderPath As String, _
                            Optional ByVal FilesExtension As String = vbNullString) As Long
        On Error Resume Next
        FolderFilesCountByExtension = 0
        Dim OFSO As New Scripting.FileSystemObject
        Dim Carpeta As Folder, Man As Long
        Carpeta = OFSO.GetFolder(FolderPath)

        If Carpeta.Files.Count > 0 Then
            If FilesExtension = vbNullString Then
                FolderFilesCountByExtension = Carpeta.Files.Count
            Else
                Dim Archivo As File
                Man = 0
                For Each Archivo In Carpeta.Files
                    If LCase(MFS.FileExtension(Archivo.Path)) = LCase(FilesExtension) Then
                        Man = Man + 1
                    End If
                Next
                FolderFilesCountByExtension = Man
            End If
        End If
    End Function

End Module
